<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html xmlns="http://www.w3.org/1999/xhtml"><head><link rel="stylesheet" type="text/css" href="style.css" /><script type="text/javascript" src="highlight.js"></script></head><body><pre><span class="hs-comment">{-
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998

A library for the ``worker\/wrapper'' back-end to the strictness analyser
-}</span><span>
</span><span id="line-6"></span><span>
</span><span id="line-7"></span><span class="hs-pragma">{-# LANGUAGE CPP #-}</span><span>
</span><span id="line-8"></span><span>
</span><span id="line-9"></span><span class="hs-keyword">module</span><span> </span><span class="hs-identifier">GHC.Core.Opt.WorkWrap.Utils</span><span>
</span><span id="line-10"></span><span>   </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWwBodies"><span class="hs-identifier">mkWwBodies</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWstr"><span class="hs-identifier">mkWWstr</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWorkerArgs"><span class="hs-identifier">mkWorkerArgs</span></a></span><span>
</span><span id="line-11"></span><span>   </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier">DataConAppContext</span></a></span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitProductType_maybe"><span class="hs-identifier">deepSplitProductType_maybe</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#wantToUnbox"><span class="hs-identifier">wantToUnbox</span></a></span><span>
</span><span id="line-12"></span><span>   </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#findTypeShape"><span class="hs-identifier">findTypeShape</span></a></span><span>
</span><span id="line-13"></span><span>   </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#isWorkerSmallEnough"><span class="hs-identifier">isWorkerSmallEnough</span></a></span><span>
</span><span id="line-14"></span><span>   </span><span class="hs-special">)</span><span>
</span><span id="line-15"></span><span class="hs-keyword">where</span><span class="hs-cpp">

#include &quot;HsVersions.h&quot;
</span><span>
</span><span id="line-19"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Prelude.html"><span class="hs-identifier">GHC.Prelude</span></a></span><span>
</span><span id="line-20"></span><span>
</span><span id="line-21"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.html"><span class="hs-identifier">GHC.Core</span></a></span><span>
</span><span id="line-22"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.Utils.html"><span class="hs-identifier">GHC.Core.Utils</span></a></span><span>   </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Core.Utils.html#exprType"><span class="hs-identifier">exprType</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Utils.html#mkCast"><span class="hs-identifier">mkCast</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Utils.html#mkDefaultCase"><span class="hs-identifier">mkDefaultCase</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Utils.html#mkSingleAltCase"><span class="hs-identifier">mkSingleAltCase</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-23"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Id.html"><span class="hs-identifier">GHC.Types.Id</span></a></span><span>
</span><span id="line-24"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Id.Info.html"><span class="hs-identifier">GHC.Types.Id.Info</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Types.Basic.html#JoinArity"><span class="hs-identifier">JoinArity</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-25"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.DataCon.html"><span class="hs-identifier">GHC.Core.DataCon</span></a></span><span>
</span><span id="line-26"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Demand.html"><span class="hs-identifier">GHC.Types.Demand</span></a></span><span>
</span><span id="line-27"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Cpr.html"><span class="hs-identifier">GHC.Types.Cpr</span></a></span><span>
</span><span id="line-28"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.Make.html"><span class="hs-identifier">GHC.Core.Make</span></a></span><span>    </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Core.Make.html#mkAbsentErrorApp"><span class="hs-identifier">mkAbsentErrorApp</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Make.html#mkCoreUbxTup"><span class="hs-identifier">mkCoreUbxTup</span></a></span><span>
</span><span id="line-29"></span><span>                        </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Make.html#mkCoreApp"><span class="hs-identifier">mkCoreApp</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Make.html#mkCoreLet"><span class="hs-identifier">mkCoreLet</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-30"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Id.Make.html"><span class="hs-identifier">GHC.Types.Id.Make</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Types.Id.Make.html#voidArgId"><span class="hs-identifier">voidArgId</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Types.Id.Make.html#voidPrimId"><span class="hs-identifier">voidPrimId</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-31"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Builtin.Types.html"><span class="hs-identifier">GHC.Builtin.Types</span></a></span><span>      </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Builtin.Types.html#tupleDataCon"><span class="hs-identifier">tupleDataCon</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-32"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Builtin.Types.Prim.html"><span class="hs-identifier">GHC.Builtin.Types.Prim</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Builtin.Types.Prim.html#voidPrimTy"><span class="hs-identifier">voidPrimTy</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-33"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Literal.html"><span class="hs-identifier">GHC.Types.Literal</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Types.Literal.html#absentLiteralOf"><span class="hs-identifier">absentLiteralOf</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Types.Literal.html#rubbishLit"><span class="hs-identifier">rubbishLit</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-34"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Var.Env.html"><span class="hs-identifier">GHC.Types.Var.Env</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Types.Var.Env.html#mkInScopeSet"><span class="hs-identifier">mkInScopeSet</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-35"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Var.Set.html"><span class="hs-identifier">GHC.Types.Var.Set</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Types.Var.Set.html#VarSet"><span class="hs-identifier">VarSet</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-36"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.Type.html"><span class="hs-identifier">GHC.Core.Type</span></a></span><span>
</span><span id="line-37"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.Multiplicity.html"><span class="hs-identifier">GHC.Core.Multiplicity</span></a></span><span>
</span><span id="line-38"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.Predicate.html"><span class="hs-identifier">GHC.Core.Predicate</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Core.Predicate.html#isClassPred"><span class="hs-identifier">isClassPred</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-39"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.RepType.html"><span class="hs-identifier">GHC.Types.RepType</span></a></span><span>  </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Types.RepType.html#isVoidTy"><span class="hs-identifier">isVoidTy</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Types.RepType.html#typePrimRep"><span class="hs-identifier">typePrimRep</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-40"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.Coercion.html"><span class="hs-identifier">GHC.Core.Coercion</span></a></span><span>
</span><span id="line-41"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html"><span class="hs-identifier">GHC.Core.FamInstEnv</span></a></span><span>
</span><span id="line-42"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Basic.html"><span class="hs-identifier">GHC.Types.Basic</span></a></span><span>       </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.Types.Basic.html#Boxity"><span class="hs-identifier">Boxity</span></a></span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-43"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Core.TyCon.html"><span class="hs-identifier">GHC.Core.TyCon</span></a></span><span>
</span><span id="line-44"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Unique.Supply.html"><span class="hs-identifier">GHC.Types.Unique.Supply</span></a></span><span>
</span><span id="line-45"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Types.Unique.html"><span class="hs-identifier">GHC.Types.Unique</span></a></span><span>
</span><span id="line-46"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Data.Maybe.html"><span class="hs-identifier">GHC.Data.Maybe</span></a></span><span>
</span><span id="line-47"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Utils.Misc.html"><span class="hs-identifier">GHC.Utils.Misc</span></a></span><span>
</span><span id="line-48"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Utils.Outputable.html"><span class="hs-identifier">GHC.Utils.Outputable</span></a></span><span>
</span><span id="line-49"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Driver.Session.html"><span class="hs-identifier">GHC.Driver.Session</span></a></span><span>
</span><span id="line-50"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Data.FastString.html"><span class="hs-identifier">GHC.Data.FastString</span></a></span><span>
</span><span id="line-51"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Data.List.SetOps.html"><span class="hs-identifier">GHC.Data.List.SetOps</span></a></span><span>
</span><span id="line-52"></span><span>
</span><span id="line-53"></span><span class="hs-comment">{-
************************************************************************
*                                                                      *
\subsection[mkWrapperAndWorker]{@mkWrapperAndWorker@}
*                                                                      *
************************************************************************

Here's an example.  The original function is:

\begin{verbatim}
g :: forall a . Int -&gt; [a] -&gt; a

g = \/\ a -&gt; \ x ys -&gt;
        case x of
          0 -&gt; head ys
          _ -&gt; head (tail ys)
\end{verbatim}

From this, we want to produce:
\begin{verbatim}
-- wrapper (an unfolding)
g :: forall a . Int -&gt; [a] -&gt; a

g = \/\ a -&gt; \ x ys -&gt;
        case x of
          I# x# -&gt; $wg a x# ys
            -- call the worker; don't forget the type args!

-- worker
$wg :: forall a . Int# -&gt; [a] -&gt; a

$wg = \/\ a -&gt; \ x# ys -&gt;
        let
            x = I# x#
        in
            case x of               -- note: body of g moved intact
              0 -&gt; head ys
              _ -&gt; head (tail ys)
\end{verbatim}

Something we have to be careful about:  Here's an example:

\begin{verbatim}
-- &quot;f&quot; strictness: U(P)U(P)
f (I# a) (I# b) = a +# b

g = f   -- &quot;g&quot; strictness same as &quot;f&quot;
\end{verbatim}

\tr{f} will get a worker all nice and friendly-like; that's good.
{\em But we don't want a worker for \tr{g}}, even though it has the
same strictness as \tr{f}.  Doing so could break laziness, at best.

Consequently, we insist that the number of strictness-info items is
exactly the same as the number of lambda-bound arguments.  (This is
probably slightly paranoid, but OK in practice.)  If it isn't the
same, we ``revise'' the strictness info, so that we won't propagate
the unusable strictness-info into the interfaces.


************************************************************************
*                                                                      *
\subsection{The worker wrapper core}
*                                                                      *
************************************************************************

@mkWwBodies@ is called when doing the worker\/wrapper split inside a module.
-}</span><span>
</span><span id="line-121"></span><span>
</span><span id="line-122"></span><span class="hs-keyword">type</span><span> </span><span id="WwResult"><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#WwResult"><span class="hs-identifier hs-var">WwResult</span></a></span></span><span>
</span><span id="line-123"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-special">(</span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span>              </span><span class="hs-comment">-- Demands for worker (value) args</span><span>
</span><span id="line-124"></span><span>     </span><span class="annot"><a href="GHC.Types.Basic.html#JoinArity"><span class="hs-identifier hs-type">JoinArity</span></a></span><span class="hs-special">,</span><span>             </span><span class="hs-comment">-- Number of worker (type OR value) args</span><span>
</span><span id="line-125"></span><span>     </span><span class="annot"><a href="GHC.Types.Var.html#Id"><span class="hs-identifier hs-type">Id</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span>        </span><span class="hs-comment">-- Wrapper body, lacking only the worker Id</span><span>
</span><span id="line-126"></span><span>     </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">)</span><span>  </span><span class="hs-comment">-- Worker body, lacking the original function rhs</span><span>
</span><span id="line-127"></span><span>
</span><span id="line-128"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWwBodies"><span class="hs-identifier hs-type">mkWwBodies</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Driver.Session.html#DynFlags"><span class="hs-identifier hs-type">DynFlags</span></a></span><span>
</span><span id="line-129"></span><span>           </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span>
</span><span id="line-130"></span><span>           </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Var.Set.html#VarSet"><span class="hs-identifier hs-type">VarSet</span></a></span><span>         </span><span class="hs-comment">-- Free vars of RHS</span><span>
</span><span id="line-131"></span><span>                             </span><span class="hs-comment">-- See Note [Freshen WW arguments]</span><span>
</span><span id="line-132"></span><span>           </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Var.html#Id"><span class="hs-identifier hs-type">Id</span></a></span><span>             </span><span class="hs-comment">-- The original function</span><span>
</span><span id="line-133"></span><span>           </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span class="hs-special">]</span><span>       </span><span class="hs-comment">-- Strictness of original function</span><span>
</span><span id="line-134"></span><span>           </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Cpr.html#CprResult"><span class="hs-identifier hs-type">CprResult</span></a></span><span>      </span><span class="hs-comment">-- Info about function result</span><span>
</span><span id="line-135"></span><span>           </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Unique.Supply.html#UniqSM"><span class="hs-identifier hs-type">UniqSM</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Maybe"><span class="hs-identifier hs-type">Maybe</span></a></span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#WwResult"><span class="hs-identifier hs-type">WwResult</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-136"></span><span>
</span><span id="line-137"></span><span class="hs-comment">-- wrap_fn_args E       = \x y -&gt; E</span><span>
</span><span id="line-138"></span><span class="hs-comment">-- work_fn_args E       = E x y</span><span>
</span><span id="line-139"></span><span>
</span><span id="line-140"></span><span class="hs-comment">-- wrap_fn_str E        = case x of { (a,b) -&gt;</span><span>
</span><span id="line-141"></span><span class="hs-comment">--                        case a of { (a1,a2) -&gt;</span><span>
</span><span id="line-142"></span><span class="hs-comment">--                        E a1 a2 b y }}</span><span>
</span><span id="line-143"></span><span class="hs-comment">-- work_fn_str E        = \a1 a2 b y -&gt;</span><span>
</span><span id="line-144"></span><span class="hs-comment">--                        let a = (a1,a2) in</span><span>
</span><span id="line-145"></span><span class="hs-comment">--                        let x = (a,b) in</span><span>
</span><span id="line-146"></span><span class="hs-comment">--                        E</span><span>
</span><span id="line-147"></span><span>
</span><span id="line-148"></span><span id="mkWwBodies"><span class="annot"><span class="annottext">mkWwBodies :: DynFlags
-&gt; FamInstEnvs
-&gt; VarSet
-&gt; Id
-&gt; [Demand]
-&gt; CprResult
-&gt; UniqSM (Maybe WwResult)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWwBodies"><span class="hs-identifier hs-var hs-var">mkWwBodies</span></a></span></span><span> </span><span id="local-6989586621680957390"><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957390"><span class="hs-identifier hs-var">dflags</span></a></span></span><span> </span><span id="local-6989586621680957389"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957389"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957388"><span class="annot"><span class="annottext">VarSet
</span><a href="#local-6989586621680957388"><span class="hs-identifier hs-var">rhs_fvs</span></a></span></span><span> </span><span id="local-6989586621680957387"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957387"><span class="hs-identifier hs-var">fun_id</span></a></span></span><span> </span><span id="local-6989586621680957386"><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957386"><span class="hs-identifier hs-var">demands</span></a></span></span><span> </span><span id="local-6989586621680957385"><span class="annot"><span class="annottext">CprResult
</span><a href="#local-6989586621680957385"><span class="hs-identifier hs-var">cpr_info</span></a></span></span><span>
</span><span id="line-149"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>  </span><span class="hs-special">{</span><span> </span><span class="hs-keyword">let</span><span> </span><span id="local-6989586621680957384"><span class="annot"><span class="annottext">empty_subst :: TCvSubst
</span><a href="#local-6989586621680957384"><span class="hs-identifier hs-var hs-var">empty_subst</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">InScopeSet -&gt; TCvSubst
</span><a href="GHC.Core.TyCo.Subst.html#mkEmptyTCvSubst"><span class="hs-identifier hs-var">mkEmptyTCvSubst</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">VarSet -&gt; InScopeSet
</span><a href="GHC.Types.Var.Env.html#mkInScopeSet"><span class="hs-identifier hs-var">mkInScopeSet</span></a></span><span> </span><span class="annot"><span class="annottext">VarSet
</span><a href="#local-6989586621680957388"><span class="hs-identifier hs-var">rhs_fvs</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-150"></span><span>                </span><span class="hs-comment">-- See Note [Freshen WW arguments]</span><span>
</span><span id="line-151"></span><span>
</span><span id="line-152"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957382"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957382"><span class="hs-identifier hs-var">wrap_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957381"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957381"><span class="hs-identifier hs-var">wrap_fn_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957380"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957380"><span class="hs-identifier hs-var">work_fn_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957379"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957379"><span class="hs-identifier hs-var">res_ty</span></a></span></span><span class="hs-special">)</span><span>
</span><span id="line-153"></span><span>             </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">TCvSubst
-&gt; Kind
-&gt; [Demand]
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWargs"><span class="hs-identifier hs-var">mkWWargs</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957384"><span class="hs-identifier hs-var">empty_subst</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957377"><span class="hs-identifier hs-var">fun_ty</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957386"><span class="hs-identifier hs-var">demands</span></a></span><span>
</span><span id="line-154"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957376"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957376"><span class="hs-identifier hs-var">useful1</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957375"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957375"><span class="hs-identifier hs-var">work_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957374"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957374"><span class="hs-identifier hs-var">wrap_fn_str</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957373"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957373"><span class="hs-identifier hs-var">work_fn_str</span></a></span></span><span class="hs-special">)</span><span>
</span><span id="line-155"></span><span>             </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">DynFlags
-&gt; FamInstEnvs
-&gt; Bool
-&gt; [Id]
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWstr"><span class="hs-identifier hs-var">mkWWstr</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957390"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957389"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957372"><span class="hs-identifier hs-var">has_inlineable_prag</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957382"><span class="hs-identifier hs-var">wrap_args</span></a></span><span>
</span><span id="line-156"></span><span>
</span><span id="line-157"></span><span>        </span><span class="hs-comment">-- Do CPR w/w.  See Note [Always do CPR w/w]</span><span>
</span><span id="line-158"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957371"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957371"><span class="hs-identifier hs-var">useful2</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957370"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957370"><span class="hs-identifier hs-var">wrap_fn_cpr</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957369"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957369"><span class="hs-identifier hs-var">work_fn_cpr</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957368"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957368"><span class="hs-identifier hs-var">cpr_res_ty</span></a></span></span><span class="hs-special">)</span><span>
</span><span id="line-159"></span><span>              </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Bool
-&gt; FamInstEnvs
-&gt; Kind
-&gt; CprResult
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWcpr"><span class="hs-identifier hs-var">mkWWcpr</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">GeneralFlag -&gt; DynFlags -&gt; Bool
</span><a href="GHC.Driver.Session.html#gopt"><span class="hs-identifier hs-var">gopt</span></a></span><span> </span><span class="annot"><span class="annottext">GeneralFlag
</span><a href="GHC.Driver.Flags.html#Opt_CprAnal"><span class="hs-identifier hs-var">Opt_CprAnal</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957390"><span class="hs-identifier hs-var">dflags</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957389"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957379"><span class="hs-identifier hs-var">res_ty</span></a></span><span> </span><span class="annot"><span class="annottext">CprResult
</span><a href="#local-6989586621680957385"><span class="hs-identifier hs-var">cpr_info</span></a></span><span>
</span><span id="line-160"></span><span>
</span><span id="line-161"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-keyword">let</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957364"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957364"><span class="hs-identifier hs-var">work_lam_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957363"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957363"><span class="hs-identifier hs-var">work_call_args</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DynFlags -&gt; [Id] -&gt; Kind -&gt; ([Id], [Id])
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWorkerArgs"><span class="hs-identifier hs-var">mkWorkerArgs</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957390"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957375"><span class="hs-identifier hs-var">work_args</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957368"><span class="hs-identifier hs-var">cpr_res_ty</span></a></span><span>
</span><span id="line-162"></span><span>              </span><span id="local-6989586621680957362"><span class="annot"><span class="annottext">worker_args_dmds :: [Demand]
</span><a href="#local-6989586621680957362"><span class="hs-identifier hs-var hs-var">worker_args_dmds</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">Id -&gt; Demand
</span><a href="GHC.Types.Id.html#idDemandInfo"><span class="hs-identifier hs-var">idDemandInfo</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957360"><span class="hs-identifier hs-var">v</span></a></span><span> </span><span class="hs-glyph">|</span><span> </span><span id="local-6989586621680957360"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957360"><span class="hs-identifier hs-var">v</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957363"><span class="hs-identifier hs-var">work_call_args</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Bool
</span><a href="GHC.Types.Var.html#isId"><span class="hs-identifier hs-var">isId</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957360"><span class="hs-identifier hs-var">v</span></a></span><span class="hs-special">]</span><span>
</span><span id="line-163"></span><span>              </span><span id="local-6989586621680957358"><span class="annot"><span class="annottext">wrapper_body :: Id -&gt; CoreExpr
</span><a href="#local-6989586621680957358"><span class="hs-identifier hs-var hs-var">wrapper_body</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957381"><span class="hs-identifier hs-var">wrap_fn_args</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; (Id -&gt; CoreExpr) -&gt; Id -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957370"><span class="hs-identifier hs-var">wrap_fn_cpr</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; (Id -&gt; CoreExpr) -&gt; Id -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957374"><span class="hs-identifier hs-var">wrap_fn_str</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; (Id -&gt; CoreExpr) -&gt; Id -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">[Id] -&gt; CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#applyToVars"><span class="hs-identifier hs-var">applyToVars</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957363"><span class="hs-identifier hs-var">work_call_args</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; (Id -&gt; CoreExpr) -&gt; Id -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">Id -&gt; CoreExpr
forall b. Id -&gt; Expr b
</span><a href="GHC.Core.html#Var"><span class="hs-identifier hs-var">Var</span></a></span><span>
</span><span id="line-164"></span><span>              </span><span id="local-6989586621680957354"><span class="annot"><span class="annottext">worker_body :: CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957354"><span class="hs-identifier hs-var hs-var">worker_body</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">[Id] -&gt; CoreExpr -&gt; CoreExpr
forall b. [b] -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#mkLams"><span class="hs-identifier hs-var">mkLams</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957364"><span class="hs-identifier hs-var">work_lam_args</span></a></span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957373"><span class="hs-identifier hs-var">work_fn_str</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957369"><span class="hs-identifier hs-var">work_fn_cpr</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957380"><span class="hs-identifier hs-var">work_fn_args</span></a></span><span>
</span><span id="line-165"></span><span>
</span><span id="line-166"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-keyword">if</span><span> </span><span class="annot"><span class="annottext">DynFlags -&gt; Int -&gt; [Id] -&gt; Bool
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#isWorkerSmallEnough"><span class="hs-identifier hs-var">isWorkerSmallEnough</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957390"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[Demand] -&gt; Int
forall (t :: * -&gt; *) a. Foldable t =&gt; t a -&gt; Int
</span><a href="../../base/src/Data.Foldable.html#length"><span class="hs-identifier hs-var">length</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957386"><span class="hs-identifier hs-var">demands</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957375"><span class="hs-identifier hs-var">work_args</span></a></span><span>
</span><span id="line-167"></span><span>             </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">&amp;&amp;</span></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool
</span><span class="hs-identifier hs-var">not</span></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[Id] -&gt; Bool
forall {a}. [a] -&gt; Bool
</span><a href="#local-6989586621680957349"><span class="hs-identifier hs-var">too_many_args_for_join_point</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957382"><span class="hs-identifier hs-var">wrap_args</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-168"></span><span>             </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">&amp;&amp;</span></span><span> </span><span class="hs-special">(</span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957376"><span class="hs-identifier hs-var">useful1</span></a></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">&amp;&amp;</span></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool
</span><span class="hs-identifier hs-var">not</span></span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957348"><span class="hs-identifier hs-var">only_one_void_argument</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">||</span></span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957371"><span class="hs-identifier hs-var">useful2</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-169"></span><span>          </span><span class="hs-keyword">then</span><span> </span><span class="annot"><span class="annottext">Maybe WwResult -&gt; UniqSM (Maybe WwResult)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">WwResult -&gt; Maybe WwResult
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957362"><span class="hs-identifier hs-var">worker_args_dmds</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">[Id] -&gt; Int
forall (t :: * -&gt; *) a. Foldable t =&gt; t a -&gt; Int
</span><a href="../../base/src/Data.Foldable.html#length"><span class="hs-identifier hs-var">length</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957363"><span class="hs-identifier hs-var">work_call_args</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-170"></span><span>                       </span><span class="annot"><span class="annottext">Id -&gt; CoreExpr
</span><a href="#local-6989586621680957358"><span class="hs-identifier hs-var">wrapper_body</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957354"><span class="hs-identifier hs-var">worker_body</span></a></span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-171"></span><span>          </span><span class="hs-keyword">else</span><span> </span><span class="annot"><span class="annottext">Maybe WwResult -&gt; UniqSM (Maybe WwResult)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="annot"><span class="annottext">Maybe WwResult
forall a. Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Nothing"><span class="hs-identifier hs-var">Nothing</span></a></span><span>
</span><span id="line-172"></span><span>        </span><span class="hs-special">}</span><span>
</span><span id="line-173"></span><span>        </span><span class="hs-comment">-- We use an INLINE unconditionally, even if the wrapper turns out to be</span><span>
</span><span id="line-174"></span><span>        </span><span class="hs-comment">-- something trivial like</span><span>
</span><span id="line-175"></span><span>        </span><span class="hs-comment">--      fw = ...</span><span>
</span><span id="line-176"></span><span>        </span><span class="hs-comment">--      f = __inline__ (coerce T fw)</span><span>
</span><span id="line-177"></span><span>        </span><span class="hs-comment">-- The point is to propagate the coerce to f's call sites, so even though</span><span>
</span><span id="line-178"></span><span>        </span><span class="hs-comment">-- f's RHS is now trivial (size 1) we still want the __inline__ to prevent</span><span>
</span><span id="line-179"></span><span>        </span><span class="hs-comment">-- fw from being inlined into f's RHS</span><span>
</span><span id="line-180"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-181"></span><span>    </span><span id="local-6989586621680957377"><span class="annot"><span class="annottext">fun_ty :: Kind
</span><a href="#local-6989586621680957377"><span class="hs-identifier hs-var hs-var">fun_ty</span></a></span></span><span>        </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Kind
</span><a href="GHC.Types.Id.html#idType"><span class="hs-identifier hs-var">idType</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957387"><span class="hs-identifier hs-var">fun_id</span></a></span><span>
</span><span id="line-182"></span><span>    </span><span id="local-6989586621680957345"><span class="annot"><span class="annottext">mb_join_arity :: Maybe Int
</span><a href="#local-6989586621680957345"><span class="hs-identifier hs-var hs-var">mb_join_arity</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Maybe Int
</span><a href="GHC.Types.Id.html#isJoinId_maybe"><span class="hs-identifier hs-var">isJoinId_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957387"><span class="hs-identifier hs-var">fun_id</span></a></span><span>
</span><span id="line-183"></span><span>    </span><span id="local-6989586621680957372"><span class="annot"><span class="annottext">has_inlineable_prag :: Bool
</span><a href="#local-6989586621680957372"><span class="hs-identifier hs-var hs-var">has_inlineable_prag</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Unfolding -&gt; Bool
</span><a href="GHC.Core.html#isStableUnfolding"><span class="hs-identifier hs-var">isStableUnfolding</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; Unfolding
</span><a href="GHC.Types.Id.html#realIdUnfolding"><span class="hs-identifier hs-var">realIdUnfolding</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957387"><span class="hs-identifier hs-var">fun_id</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-184"></span><span>                          </span><span class="hs-comment">-- See Note [Do not unpack class dictionaries]</span><span>
</span><span id="line-185"></span><span>
</span><span id="line-186"></span><span>    </span><span class="hs-comment">-- Note [Do not split void functions]</span><span>
</span><span id="line-187"></span><span>    </span><span id="local-6989586621680957348"><span class="annot"><span class="annottext">only_one_void_argument :: Bool
</span><a href="#local-6989586621680957348"><span class="hs-identifier hs-var hs-var">only_one_void_argument</span></a></span></span><span>
</span><span id="line-188"></span><span>      </span><span class="hs-glyph">|</span><span> </span><span class="hs-special">[</span><span id="local-6989586621680957341"><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957341"><span class="hs-identifier hs-var">d</span></a></span></span><span class="hs-special">]</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957386"><span class="hs-identifier hs-var">demands</span></a></span><span>
</span><span id="line-189"></span><span>      </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind
</span><span class="hs-identifier">_</span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957340"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957340"><span class="hs-identifier hs-var">arg_ty1</span></a></span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><span class="hs-identifier">_</span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Maybe (Kind, Kind, Kind)
</span><a href="GHC.Core.Type.html#splitFunTy_maybe"><span class="hs-identifier hs-var">splitFunTy_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957377"><span class="hs-identifier hs-var">fun_ty</span></a></span><span>
</span><span id="line-190"></span><span>      </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Demand -&gt; Bool
forall s u. JointDmd (Str s) (Use u) -&gt; Bool
</span><a href="GHC.Types.Demand.html#isAbsDmd"><span class="hs-identifier hs-var">isAbsDmd</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957341"><span class="hs-identifier hs-var">d</span></a></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">&amp;&amp;</span></span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Bool
</span><a href="GHC.Types.RepType.html#isVoidTy"><span class="hs-identifier hs-var">isVoidTy</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957340"><span class="hs-identifier hs-var">arg_ty1</span></a></span><span>
</span><span id="line-191"></span><span>      </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">True</span></span><span>
</span><span id="line-192"></span><span>      </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-193"></span><span>      </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span>
</span><span id="line-194"></span><span>
</span><span id="line-195"></span><span>    </span><span class="hs-comment">-- Note [Join points returning functions]</span><span>
</span><span id="line-196"></span><span>    </span><span id="local-6989586621680957349"><span class="annot"><span class="annottext">too_many_args_for_join_point :: [a] -&gt; Bool
</span><a href="#local-6989586621680957349"><span class="hs-identifier hs-var hs-var">too_many_args_for_join_point</span></a></span></span><span> </span><span id="local-6989586621680957334"><span class="annot"><span class="annottext">[a]
</span><a href="#local-6989586621680957334"><span class="hs-identifier hs-var">wrap_args</span></a></span></span><span>
</span><span id="line-197"></span><span>      </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957333"><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957333"><span class="hs-identifier hs-var">join_arity</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Maybe Int
</span><a href="#local-6989586621680957345"><span class="hs-identifier hs-var">mb_join_arity</span></a></span><span>
</span><span id="line-198"></span><span>      </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">[a]
</span><a href="#local-6989586621680957334"><span class="hs-identifier hs-var">wrap_args</span></a></span><span> </span><span class="annot"><span class="annottext">[a] -&gt; Int -&gt; Bool
forall a. [a] -&gt; Int -&gt; Bool
</span><a href="GHC.Utils.Misc.html#lengthExceeds"><span class="hs-operator hs-var">`lengthExceeds`</span></a></span><span> </span><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957333"><span class="hs-identifier hs-var">join_arity</span></a></span><span>
</span><span id="line-199"></span><span>      </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">WARN</span><span class="hs-special">(</span><span class="hs-identifier">True</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">text</span><span> </span><span class="hs-string">&quot;Unable to worker/wrapper join point with arity &quot;</span><span> </span><span class="hs-operator">&lt;+&gt;</span><span>
</span><span id="line-200"></span><span>                     </span><span class="hs-identifier">int</span><span> </span><span class="hs-identifier">join_arity</span><span> </span><span class="hs-operator">&lt;+&gt;</span><span> </span><span class="hs-identifier">text</span><span> </span><span class="hs-string">&quot;but&quot;</span><span> </span><span class="hs-operator">&lt;+&gt;</span><span>
</span><span id="line-201"></span><span>                     </span><span class="hs-identifier">int</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">length</span><span> </span><span class="hs-identifier">wrap_args</span><span class="hs-special">)</span><span> </span><span class="hs-operator">&lt;+&gt;</span><span> </span><span class="hs-identifier">text</span><span> </span><span class="hs-string">&quot;args&quot;</span><span class="hs-special">)</span><span>
</span><span id="line-202"></span><span>        </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">True</span></span><span>
</span><span id="line-203"></span><span>      </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-204"></span><span>      </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span>
</span><span id="line-205"></span><span>
</span><span id="line-206"></span><span class="hs-comment">-- See Note [Limit w/w arity]</span><span>
</span><span id="line-207"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#isWorkerSmallEnough"><span class="hs-identifier hs-type">isWorkerSmallEnough</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Driver.Session.html#DynFlags"><span class="hs-identifier hs-type">DynFlags</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">Int</span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span>
</span><span id="line-208"></span><span id="isWorkerSmallEnough"><span class="annot"><span class="annottext">isWorkerSmallEnough :: DynFlags -&gt; Int -&gt; [Id] -&gt; Bool
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#isWorkerSmallEnough"><span class="hs-identifier hs-var hs-var">isWorkerSmallEnough</span></a></span></span><span> </span><span id="local-6989586621680957326"><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957326"><span class="hs-identifier hs-var">dflags</span></a></span></span><span> </span><span id="local-6989586621680957325"><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957325"><span class="hs-identifier hs-var">old_n_args</span></a></span></span><span> </span><span id="local-6989586621680957324"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957324"><span class="hs-identifier hs-var">vars</span></a></span></span><span>
</span><span id="line-209"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(Id -&gt; Bool) -&gt; [Id] -&gt; Int
forall a. (a -&gt; Bool) -&gt; [a] -&gt; Int
</span><a href="GHC.Utils.Misc.html#count"><span class="hs-identifier hs-var">count</span></a></span><span> </span><span class="annot"><span class="annottext">Id -&gt; Bool
</span><a href="GHC.Types.Var.html#isId"><span class="hs-identifier hs-var">isId</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957324"><span class="hs-identifier hs-var">vars</span></a></span><span> </span><span class="annot"><span class="annottext">Int -&gt; Int -&gt; Bool
forall a. Ord a =&gt; a -&gt; a -&gt; Bool
</span><span class="hs-operator hs-var">&lt;=</span></span><span> </span><span class="annot"><span class="annottext">Int -&gt; Int -&gt; Int
forall a. Ord a =&gt; a -&gt; a -&gt; a
</span><span class="hs-identifier hs-var">max</span></span><span> </span><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957325"><span class="hs-identifier hs-var">old_n_args</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">DynFlags -&gt; Int
</span><a href="GHC.Driver.Session.html#maxWorkerArgs"><span class="hs-identifier hs-var hs-var">maxWorkerArgs</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957326"><span class="hs-identifier hs-var">dflags</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-210"></span><span>    </span><span class="hs-comment">-- We count only Free variables (isId) to skip Type, Kind</span><span>
</span><span id="line-211"></span><span>    </span><span class="hs-comment">-- variables which have no runtime representation.</span><span>
</span><span id="line-212"></span><span>    </span><span class="hs-comment">-- Also if the function took 82 arguments before (old_n_args), it's fine if</span><span>
</span><span id="line-213"></span><span>    </span><span class="hs-comment">-- it takes &lt;= 82 arguments afterwards.</span><span>
</span><span id="line-214"></span><span>
</span><span id="line-215"></span><span class="hs-comment">{-
Note [Always do CPR w/w]
~~~~~~~~~~~~~~~~~~~~~~~~
At one time we refrained from doing CPR w/w for thunks, on the grounds that
we might duplicate work.  But that is already handled by the demand analyser,
which doesn't give the CPR property if w/w might waste work: see
Note [CPR for thunks] in GHC.Core.Opt.DmdAnal.

And if something *has* been given the CPR property and we don't w/w, it's
a disaster, because then the enclosing function might say it has the CPR
property, but now doesn't and there a cascade of disaster.  A good example
is #5920.

Note [Limit w/w arity]
~~~~~~~~~~~~~~~~~~~~~~~~
Guard against high worker arity as it generates a lot of stack traffic.
A simplified example is #11565#comment:6

Current strategy is very simple: don't perform w/w transformation at all
if the result produces a wrapper with arity higher than -fmax-worker-args
and the number arguments before w/w (see #18122).

It is a bit all or nothing, consider

        f (x,y) (a,b,c,d,e ... , z) = rhs

Currently we will remove all w/w ness entirely. But actually we could
w/w on the (x,y) pair... it's the huge product that is the problem.

Could we instead refrain from w/w on an arg-by-arg basis? Yes, that'd
solve f. But we can get a lot of args from deeply-nested products:

        g (a, (b, (c, (d, ...)))) = rhs

This is harder to spot on an arg-by-arg basis. Previously mkWwStr was
given some &quot;fuel&quot; saying how many arguments it could add; when we ran
out of fuel it would stop w/wing.

Still not very clever because it had a left-right bias.

************************************************************************
*                                                                      *
\subsection{Making wrapper args}
*                                                                      *
************************************************************************

During worker-wrapper stuff we may end up with an unlifted thing
which we want to let-bind without losing laziness.  So we
add a void argument.  E.g.

        f = /\a -&gt; \x y z -&gt; E::Int#    -- E does not mention x,y,z
==&gt;
        fw = /\ a -&gt; \void -&gt; E
        f  = /\ a -&gt; \x y z -&gt; fw realworld

We use the state-token type which generates no code.
-}</span><span>
</span><span id="line-272"></span><span>
</span><span id="line-273"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWorkerArgs"><span class="hs-identifier hs-type">mkWorkerArgs</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Driver.Session.html#DynFlags"><span class="hs-identifier hs-type">DynFlags</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span>
</span><span id="line-274"></span><span>             </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span>    </span><span class="hs-comment">-- Type of body</span><span>
</span><span id="line-275"></span><span>             </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">(</span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="hs-comment">-- Lambda bound args</span><span>
</span><span id="line-276"></span><span>                 </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span class="hs-special">)</span><span> </span><span class="hs-comment">-- Args at call site</span><span>
</span><span id="line-277"></span><span id="mkWorkerArgs"><span class="annot"><span class="annottext">mkWorkerArgs :: DynFlags -&gt; [Id] -&gt; Kind -&gt; ([Id], [Id])
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWorkerArgs"><span class="hs-identifier hs-var hs-var">mkWorkerArgs</span></a></span></span><span> </span><span id="local-6989586621680957318"><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957318"><span class="hs-identifier hs-var">dflags</span></a></span></span><span> </span><span id="local-6989586621680957317"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957317"><span class="hs-identifier hs-var">args</span></a></span></span><span> </span><span id="local-6989586621680957316"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957316"><span class="hs-identifier hs-var">res_ty</span></a></span></span><span>
</span><span id="line-278"></span><span>    </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">(Id -&gt; Bool) -&gt; [Id] -&gt; Bool
forall (t :: * -&gt; *) a. Foldable t =&gt; (a -&gt; Bool) -&gt; t a -&gt; Bool
</span><a href="../../base/src/Data.Foldable.html#any"><span class="hs-identifier hs-var">any</span></a></span><span> </span><span class="annot"><span class="annottext">Id -&gt; Bool
</span><a href="GHC.Types.Var.html#isId"><span class="hs-identifier hs-var">isId</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957317"><span class="hs-identifier hs-var">args</span></a></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">||</span></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool
</span><span class="hs-identifier hs-var">not</span></span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957314"><span class="hs-identifier hs-var">needsAValueLambda</span></a></span><span>
</span><span id="line-279"></span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957317"><span class="hs-identifier hs-var">args</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957317"><span class="hs-identifier hs-var">args</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-280"></span><span>    </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-281"></span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957317"><span class="hs-identifier hs-var">args</span></a></span><span> </span><span class="annot"><span class="annottext">[Id] -&gt; [Id] -&gt; [Id]
forall a. [a] -&gt; [a] -&gt; [a]
</span><a href="../../base/src/GHC.Base.html#%2B%2B"><span class="hs-operator hs-var">++</span></a></span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">Id
</span><a href="GHC.Types.Id.Make.html#voidArgId"><span class="hs-identifier hs-var">voidArgId</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957317"><span class="hs-identifier hs-var">args</span></a></span><span> </span><span class="annot"><span class="annottext">[Id] -&gt; [Id] -&gt; [Id]
forall a. [a] -&gt; [a] -&gt; [a]
</span><a href="../../base/src/GHC.Base.html#%2B%2B"><span class="hs-operator hs-var">++</span></a></span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">Id
</span><a href="GHC.Types.Id.Make.html#voidPrimId"><span class="hs-identifier hs-var">voidPrimId</span></a></span><span class="hs-special">]</span><span class="hs-special">)</span><span>
</span><span id="line-282"></span><span>    </span><span class="hs-keyword">where</span><span>
</span><span id="line-283"></span><span>      </span><span class="hs-comment">-- See &quot;Making wrapper args&quot; section above</span><span>
</span><span id="line-284"></span><span>      </span><span id="local-6989586621680957314"><span class="annot"><span class="annottext">needsAValueLambda :: Bool
</span><a href="#local-6989586621680957314"><span class="hs-identifier hs-var hs-var">needsAValueLambda</span></a></span></span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-285"></span><span>        </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957313"><span class="hs-identifier hs-var">lifted</span></a></span><span>
</span><span id="line-286"></span><span>        </span><span class="hs-comment">-- We may encounter a levity-polymorphic result, in which case we</span><span>
</span><span id="line-287"></span><span>        </span><span class="hs-comment">-- conservatively assume that we have laziness that needs preservation.</span><span>
</span><span id="line-288"></span><span>        </span><span class="hs-comment">-- See #15186.</span><span>
</span><span id="line-289"></span><span>        </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">||</span></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool
</span><span class="hs-identifier hs-var">not</span></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">GeneralFlag -&gt; DynFlags -&gt; Bool
</span><a href="GHC.Driver.Session.html#gopt"><span class="hs-identifier hs-var">gopt</span></a></span><span> </span><span class="annot"><span class="annottext">GeneralFlag
</span><a href="GHC.Driver.Flags.html#Opt_FunToThunk"><span class="hs-identifier hs-var">Opt_FunToThunk</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957318"><span class="hs-identifier hs-var">dflags</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-290"></span><span>           </span><span class="hs-comment">-- see Note [Protecting the last value argument]</span><span>
</span><span id="line-291"></span><span>
</span><span id="line-292"></span><span>      </span><span class="hs-comment">-- Might the result be lifted?</span><span>
</span><span id="line-293"></span><span>      </span><span id="local-6989586621680957313"><span class="annot"><span class="annottext">lifted :: Bool
</span><a href="#local-6989586621680957313"><span class="hs-identifier hs-var hs-var">lifted</span></a></span></span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-294"></span><span>        </span><span class="hs-keyword">case</span><span> </span><span class="annot"><span class="annottext">HasDebugCallStack =&gt; Kind -&gt; Maybe Bool
Kind -&gt; Maybe Bool
</span><a href="GHC.Core.Type.html#isLiftedType_maybe"><span class="hs-identifier hs-var">isLiftedType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957316"><span class="hs-identifier hs-var">res_ty</span></a></span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-295"></span><span>          </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957309"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957309"><span class="hs-identifier hs-var">lifted</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957309"><span class="hs-identifier hs-var">lifted</span></a></span><span>
</span><span id="line-296"></span><span>          </span><span class="annot"><span class="annottext">Maybe Bool
</span><a href="../../base/src/GHC.Maybe.html#Nothing"><span class="hs-identifier hs-var">Nothing</span></a></span><span>     </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">True</span></span><span>
</span><span id="line-297"></span><span>
</span><span id="line-298"></span><span class="hs-comment">{-
Note [Protecting the last value argument]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If the user writes (\_ -&gt; E), they might be intentionally disallowing
the sharing of E. Since absence analysis and worker-wrapper are keen
to remove such unused arguments, we add in a void argument to prevent
the function from becoming a thunk.

The user can avoid adding the void argument with the -ffun-to-thunk
flag. However, this can create sharing, which may be bad in two ways. 1) It can
create a space leak. 2) It can prevent inlining *under a lambda*. If w/w
removes the last argument from a function f, then f now looks like a thunk, and
so f can't be inlined *under a lambda*.

Note [Join points and beta-redexes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Originally, the worker would invoke the original function by calling it with
arguments, thus producing a beta-redex for the simplifier to munch away:

  \x y z -&gt; e =&gt; (\x y z -&gt; e) wx wy wz

Now that we have special rules about join points, however, this is Not Good if
the original function is itself a join point, as then it may contain invocations
of other join points:

  join j1 x = ...
  join j2 y = if y == 0 then 0 else j1 y

  =&gt;

  join j1 x = ...
  join $wj2 y# = let wy = I# y# in (\y -&gt; if y == 0 then 0 else jump j1 y) wy
  join j2 y = case y of I# y# -&gt; jump $wj2 y#

There can't be an intervening lambda between a join point's declaration and its
occurrences, so $wj2 here is wrong. But of course, this is easy enough to fix:

  ...
  let join $wj2 y# = let wy = I# y# in let y = wy in if y == 0 then 0 else j1 y
  ...

Hence we simply do the beta-reduction here. (This would be harder if we had to
worry about hygiene, but luckily wy is freshly generated.)

Note [Join points returning functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

It is crucial that the arity of a join point depends on its *callers,* not its
own syntax. What this means is that a join point can have &quot;extra lambdas&quot;:

f :: Int -&gt; Int -&gt; (Int, Int) -&gt; Int
f x y = join j (z, w) = \(u, v) -&gt; ...
        in jump j (x, y)

Typically this happens with functions that are seen as computing functions,
rather than being curried. (The real-life example was GHC.Data.Graph.Ops.addConflicts.)

When we create the wrapper, it *must* be in &quot;eta-contracted&quot; form so that the
jump has the right number of arguments:

f x y = join $wj z' w' = \u' v' -&gt; let {z = z'; w = w'; u = u'; v = v'} in ...
             j (z, w)  = jump $wj z w

(See Note [Join points and beta-redexes] for where the lets come from.) If j
were a function, we would instead say

f x y = let $wj = \z' w' u' v' -&gt; let {z = z'; w = w'; u = u'; v = v'} in ...
            j (z, w) (u, v) = $wj z w u v

Notice that the worker ends up with the same lambdas; it's only the wrapper we
have to be concerned about.

FIXME Currently the functionality to produce &quot;eta-contracted&quot; wrappers is
unimplemented; we simply give up.

************************************************************************
*                                                                      *
\subsection{Coercion stuff}
*                                                                      *
************************************************************************

We really want to &quot;look through&quot; coerces.
Reason: I've seen this situation:

        let f = coerce T (\s -&gt; E)
        in \x -&gt; case x of
                    p -&gt; coerce T' f
                    q -&gt; \s -&gt; E2
                    r -&gt; coerce T' f

If only we w/w'd f, we'd get
        let f = coerce T (\s -&gt; fw s)
            fw = \s -&gt; E
        in ...

Now we'll inline f to get

        let fw = \s -&gt; E
        in \x -&gt; case x of
                    p -&gt; fw
                    q -&gt; \s -&gt; E2
                    r -&gt; fw

Now we'll see that fw has arity 1, and will arity expand
the \x to get what we want.
-}</span><span>
</span><span id="line-405"></span><span>
</span><span id="line-406"></span><span class="hs-comment">-- mkWWargs just does eta expansion</span><span>
</span><span id="line-407"></span><span class="hs-comment">-- is driven off the function type and arity.</span><span>
</span><span id="line-408"></span><span class="hs-comment">-- It chomps bites off foralls, arrows, newtypes</span><span>
</span><span id="line-409"></span><span class="hs-comment">-- and keeps repeating that until it's satisfied the supplied arity</span><span>
</span><span id="line-410"></span><span>
</span><span id="line-411"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWargs"><span class="hs-identifier hs-type">mkWWargs</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Subst.html#TCvSubst"><span class="hs-identifier hs-type">TCvSubst</span></a></span><span>            </span><span class="hs-comment">-- Freshening substitution to apply to the type</span><span>
</span><span id="line-412"></span><span>                                </span><span class="hs-comment">--   See Note [Freshen WW arguments]</span><span>
</span><span id="line-413"></span><span>         </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span>                </span><span class="hs-comment">-- The type of the function</span><span>
</span><span id="line-414"></span><span>         </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span class="hs-special">]</span><span>     </span><span class="hs-comment">-- Demands and one-shot info for value arguments</span><span>
</span><span id="line-415"></span><span>         </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Unique.Supply.html#UniqSM"><span class="hs-identifier hs-type">UniqSM</span></a></span><span>  </span><span class="hs-special">(</span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span>            </span><span class="hs-comment">-- Wrapper args</span><span>
</span><span id="line-416"></span><span>                     </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span>      </span><span class="hs-comment">-- Wrapper fn</span><span>
</span><span id="line-417"></span><span>                     </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span>      </span><span class="hs-comment">-- Worker fn</span><span>
</span><span id="line-418"></span><span>                     </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span class="hs-special">)</span><span>                      </span><span class="hs-comment">-- Type of wrapper body</span><span>
</span><span id="line-419"></span><span>
</span><span id="line-420"></span><span id="mkWWargs"><span class="annot"><span class="annottext">mkWWargs :: TCvSubst
-&gt; Kind
-&gt; [Demand]
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWargs"><span class="hs-identifier hs-var hs-var">mkWWargs</span></a></span></span><span> </span><span id="local-6989586621680957308"><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957308"><span class="hs-identifier hs-var">subst</span></a></span></span><span> </span><span id="local-6989586621680957307"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957307"><span class="hs-identifier hs-var">fun_ty</span></a></span></span><span> </span><span id="local-6989586621680957306"><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957306"><span class="hs-identifier hs-var">demands</span></a></span></span><span>
</span><span id="line-421"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">[Demand] -&gt; Bool
forall (t :: * -&gt; *) a. Foldable t =&gt; t a -&gt; Bool
</span><a href="../../base/src/Data.Foldable.html#null"><span class="hs-identifier hs-var">null</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957306"><span class="hs-identifier hs-var">demands</span></a></span><span>
</span><span id="line-422"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="hs-special">[</span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">HasCallStack =&gt; TCvSubst -&gt; Kind -&gt; Kind
TCvSubst -&gt; Kind -&gt; Kind
</span><a href="GHC.Core.TyCo.Subst.html#substTy"><span class="hs-identifier hs-var">substTy</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957308"><span class="hs-identifier hs-var">subst</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957307"><span class="hs-identifier hs-var">fun_ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-423"></span><span>
</span><span id="line-424"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957302"><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957302"><span class="hs-identifier hs-var">dmd</span></a></span></span><span class="annot"><span class="hs-glyph hs-type">:</span></span><span id="local-6989586621680957301"><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957301"><span class="hs-identifier hs-var">demands'</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957306"><span class="hs-identifier hs-var">demands</span></a></span><span>
</span><span id="line-425"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957300"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957300"><span class="hs-identifier hs-var">mult</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957299"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957299"><span class="hs-identifier hs-var">arg_ty</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957298"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957298"><span class="hs-identifier hs-var">fun_ty'</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Maybe (Kind, Kind, Kind)
</span><a href="GHC.Core.Type.html#splitFunTy_maybe"><span class="hs-identifier hs-var">splitFunTy_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957307"><span class="hs-identifier hs-var">fun_ty</span></a></span><span>
</span><span id="line-426"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>  </span><span class="hs-special">{</span><span> </span><span id="local-6989586621680957297"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957297"><span class="hs-identifier hs-var">uniq</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">UniqSM Unique
forall (m :: * -&gt; *). MonadUnique m =&gt; m Unique
</span><a href="GHC.Types.Unique.Supply.html#getUniqueM"><span class="hs-identifier hs-var">getUniqueM</span></a></span><span>
</span><span id="line-427"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-keyword">let</span><span> </span><span id="local-6989586621680957293"><span class="annot"><span class="annottext">arg_ty' :: Scaled Kind
</span><a href="#local-6989586621680957293"><span class="hs-identifier hs-var hs-var">arg_ty'</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">HasCallStack =&gt; TCvSubst -&gt; Scaled Kind -&gt; Scaled Kind
TCvSubst -&gt; Scaled Kind -&gt; Scaled Kind
</span><a href="GHC.Core.TyCo.Subst.html#substScaledTy"><span class="hs-identifier hs-var">substScaledTy</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957308"><span class="hs-identifier hs-var">subst</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind -&gt; Kind -&gt; Scaled Kind
forall a. Kind -&gt; a -&gt; Scaled a
</span><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-var">Scaled</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957300"><span class="hs-identifier hs-var">mult</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957299"><span class="hs-identifier hs-var">arg_ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-428"></span><span>              </span><span id="local-6989586621680957290"><span class="annot"><span class="annottext">id :: Id
</span><a href="#local-6989586621680957290"><span class="hs-identifier hs-var hs-var">id</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Unique -&gt; Scaled Kind -&gt; Demand -&gt; Id
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_wrap_arg"><span class="hs-identifier hs-var">mk_wrap_arg</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957297"><span class="hs-identifier hs-var">uniq</span></a></span><span> </span><span class="annot"><span class="annottext">Scaled Kind
</span><a href="#local-6989586621680957293"><span class="hs-identifier hs-var">arg_ty'</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957302"><span class="hs-identifier hs-var">dmd</span></a></span><span>
</span><span id="line-429"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957288"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957288"><span class="hs-identifier hs-var">wrap_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957287"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957287"><span class="hs-identifier hs-var">wrap_fn_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957286"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957286"><span class="hs-identifier hs-var">work_fn_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957285"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957285"><span class="hs-identifier hs-var">res_ty</span></a></span></span><span class="hs-special">)</span><span>
</span><span id="line-430"></span><span>              </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">TCvSubst
-&gt; Kind
-&gt; [Demand]
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWargs"><span class="hs-identifier hs-var">mkWWargs</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957308"><span class="hs-identifier hs-var">subst</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957298"><span class="hs-identifier hs-var">fun_ty'</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957301"><span class="hs-identifier hs-var">demands'</span></a></span><span>
</span><span id="line-431"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="annot"><span class="annottext">([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957290"><span class="hs-identifier hs-var">id</span></a></span><span> </span><span class="annot"><span class="annottext">Id -&gt; [Id] -&gt; [Id]
forall a. a -&gt; [a] -&gt; [a]
</span><span class="hs-glyph hs-var">:</span></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957288"><span class="hs-identifier hs-var">wrap_args</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-432"></span><span>                  </span><span class="annot"><span class="annottext">Id -&gt; CoreExpr -&gt; CoreExpr
forall b. b -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#Lam"><span class="hs-identifier hs-var">Lam</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957290"><span class="hs-identifier hs-var">id</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957287"><span class="hs-identifier hs-var">wrap_fn_args</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-433"></span><span>                  </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957283"><span class="hs-identifier hs-var">apply_or_bind_then</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957286"><span class="hs-identifier hs-var">work_fn_args</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr
forall b. Id -&gt; Expr b
</span><a href="GHC.Core.html#varToCoreExpr"><span class="hs-identifier hs-var">varToCoreExpr</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957290"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">)</span><span class="hs-special">,</span><span>
</span><span id="line-434"></span><span>                  </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957285"><span class="hs-identifier hs-var">res_ty</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-435"></span><span>
</span><span id="line-436"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957281"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957281"><span class="hs-identifier hs-var">tv</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957280"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957280"><span class="hs-identifier hs-var">fun_ty'</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Maybe (Id, Kind)
</span><a href="GHC.Core.Type.html#splitForAllTy_maybe"><span class="hs-identifier hs-var">splitForAllTy_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957307"><span class="hs-identifier hs-var">fun_ty</span></a></span><span>
</span><span id="line-437"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>  </span><span class="hs-special">{</span><span> </span><span id="local-6989586621680957278"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957278"><span class="hs-identifier hs-var">uniq</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">UniqSM Unique
forall (m :: * -&gt; *). MonadUnique m =&gt; m Unique
</span><a href="GHC.Types.Unique.Supply.html#getUniqueM"><span class="hs-identifier hs-var">getUniqueM</span></a></span><span>
</span><span id="line-438"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-keyword">let</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957277"><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957277"><span class="hs-identifier hs-var">subst'</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957276"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957276"><span class="hs-identifier hs-var">tv'</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">TCvSubst -&gt; Id -&gt; Unique -&gt; (TCvSubst, Id)
</span><a href="GHC.Core.TyCo.Subst.html#cloneTyVarBndr"><span class="hs-identifier hs-var">cloneTyVarBndr</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957308"><span class="hs-identifier hs-var">subst</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957281"><span class="hs-identifier hs-var">tv</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957278"><span class="hs-identifier hs-var">uniq</span></a></span><span>
</span><span id="line-439"></span><span>                </span><span class="hs-comment">-- See Note [Freshen WW arguments]</span><span>
</span><span id="line-440"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957274"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957274"><span class="hs-identifier hs-var">wrap_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957273"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957273"><span class="hs-identifier hs-var">wrap_fn_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957272"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957272"><span class="hs-identifier hs-var">work_fn_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957271"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957271"><span class="hs-identifier hs-var">res_ty</span></a></span></span><span class="hs-special">)</span><span>
</span><span id="line-441"></span><span>             </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">TCvSubst
-&gt; Kind
-&gt; [Demand]
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWargs"><span class="hs-identifier hs-var">mkWWargs</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957277"><span class="hs-identifier hs-var">subst'</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957280"><span class="hs-identifier hs-var">fun_ty'</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957306"><span class="hs-identifier hs-var">demands</span></a></span><span>
</span><span id="line-442"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="annot"><span class="annottext">([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957276"><span class="hs-identifier hs-var">tv'</span></a></span><span> </span><span class="annot"><span class="annottext">Id -&gt; [Id] -&gt; [Id]
forall a. a -&gt; [a] -&gt; [a]
</span><span class="hs-glyph hs-var">:</span></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957274"><span class="hs-identifier hs-var">wrap_args</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-443"></span><span>                  </span><span class="annot"><span class="annottext">Id -&gt; CoreExpr -&gt; CoreExpr
forall b. b -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#Lam"><span class="hs-identifier hs-var">Lam</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957276"><span class="hs-identifier hs-var">tv'</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957273"><span class="hs-identifier hs-var">wrap_fn_args</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-444"></span><span>                  </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957283"><span class="hs-identifier hs-var">apply_or_bind_then</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957272"><span class="hs-identifier hs-var">work_fn_args</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind -&gt; CoreExpr
forall b. Kind -&gt; Expr b
</span><a href="GHC.Core.html#mkTyArg"><span class="hs-identifier hs-var">mkTyArg</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; Kind
</span><a href="GHC.Core.TyCo.Rep.html#mkTyVarTy"><span class="hs-identifier hs-var">mkTyVarTy</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957276"><span class="hs-identifier hs-var">tv'</span></a></span><span class="hs-special">)</span><span class="hs-special">)</span><span class="hs-special">,</span><span>
</span><span id="line-445"></span><span>                  </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957271"><span class="hs-identifier hs-var">res_ty</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-446"></span><span>
</span><span id="line-447"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957268"><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957268"><span class="hs-identifier hs-var">co</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957267"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957267"><span class="hs-identifier hs-var">rep_ty</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Maybe (Coercion, Kind)
</span><a href="GHC.Core.Coercion.html#topNormaliseNewType_maybe"><span class="hs-identifier hs-var">topNormaliseNewType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957307"><span class="hs-identifier hs-var">fun_ty</span></a></span><span>
</span><span id="line-448"></span><span>        </span><span class="hs-comment">-- The newtype case is for when the function has</span><span>
</span><span id="line-449"></span><span>        </span><span class="hs-comment">-- a newtype after the arrow (rare)</span><span>
</span><span id="line-450"></span><span>        </span><span class="hs-comment">--</span><span>
</span><span id="line-451"></span><span>        </span><span class="hs-comment">-- It's also important when we have a function returning (say) a pair</span><span>
</span><span id="line-452"></span><span>        </span><span class="hs-comment">-- wrapped in a  newtype, at least if CPR analysis can look</span><span>
</span><span id="line-453"></span><span>        </span><span class="hs-comment">-- through such newtypes, which it probably can since they are</span><span>
</span><span id="line-454"></span><span>        </span><span class="hs-comment">-- simply coerces.</span><span>
</span><span id="line-455"></span><span>
</span><span id="line-456"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-special">{</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957265"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957265"><span class="hs-identifier hs-var">wrap_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957264"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957264"><span class="hs-identifier hs-var">wrap_fn_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957263"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957263"><span class="hs-identifier hs-var">work_fn_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957262"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957262"><span class="hs-identifier hs-var">res_ty</span></a></span></span><span class="hs-special">)</span><span>
</span><span id="line-457"></span><span>            </span><span class="hs-glyph">&lt;-</span><span>  </span><span class="annot"><span class="annottext">TCvSubst
-&gt; Kind
-&gt; [Demand]
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWargs"><span class="hs-identifier hs-var">mkWWargs</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957308"><span class="hs-identifier hs-var">subst</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957267"><span class="hs-identifier hs-var">rep_ty</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957306"><span class="hs-identifier hs-var">demands</span></a></span><span>
</span><span id="line-458"></span><span>       </span><span class="hs-special">;</span><span> </span><span class="hs-keyword">let</span><span> </span><span id="local-6989586621680957259"><span class="annot"><span class="annottext">co' :: Coercion
</span><a href="#local-6989586621680957259"><span class="hs-identifier hs-var hs-var">co'</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">HasCallStack =&gt; TCvSubst -&gt; Coercion -&gt; Coercion
TCvSubst -&gt; Coercion -&gt; Coercion
</span><a href="GHC.Core.TyCo.Subst.html#substCo"><span class="hs-identifier hs-var">substCo</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957308"><span class="hs-identifier hs-var">subst</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957268"><span class="hs-identifier hs-var">co</span></a></span><span>
</span><span id="line-459"></span><span>       </span><span class="hs-special">;</span><span> </span><span class="annot"><span class="annottext">([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957265"><span class="hs-identifier hs-var">wrap_args</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-460"></span><span>                  </span><span class="hs-glyph">\</span><span id="local-6989586621680957257"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957257"><span class="hs-identifier hs-var">e</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Coercion -&gt; CoreExpr
forall b. Expr b -&gt; Coercion -&gt; Expr b
</span><a href="GHC.Core.html#Cast"><span class="hs-identifier hs-var">Cast</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957264"><span class="hs-identifier hs-var">wrap_fn_args</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957257"><span class="hs-identifier hs-var">e</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Coercion -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkSymCo"><span class="hs-identifier hs-var">mkSymCo</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957259"><span class="hs-identifier hs-var">co'</span></a></span><span class="hs-special">)</span><span class="hs-special">,</span><span>
</span><span id="line-461"></span><span>                  </span><span class="hs-glyph">\</span><span id="local-6989586621680957254"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957254"><span class="hs-identifier hs-var">e</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957263"><span class="hs-identifier hs-var">work_fn_args</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreExpr -&gt; Coercion -&gt; CoreExpr
forall b. Expr b -&gt; Coercion -&gt; Expr b
</span><a href="GHC.Core.html#Cast"><span class="hs-identifier hs-var">Cast</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957254"><span class="hs-identifier hs-var">e</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957259"><span class="hs-identifier hs-var">co'</span></a></span><span class="hs-special">)</span><span class="hs-special">,</span><span>
</span><span id="line-462"></span><span>                  </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957262"><span class="hs-identifier hs-var">res_ty</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-463"></span><span>
</span><span id="line-464"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-465"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">WARN</span><span class="hs-special">(</span><span> </span><span class="hs-identifier">True</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">ppr</span><span> </span><span class="hs-identifier">fun_ty</span><span> </span><span class="hs-special">)</span><span>                    </span><span class="hs-comment">-- Should not happen: if there is a demand</span><span>
</span><span id="line-466"></span><span>    </span><span class="annot"><span class="annottext">([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM ([Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="hs-special">[</span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">HasCallStack =&gt; TCvSubst -&gt; Kind -&gt; Kind
TCvSubst -&gt; Kind -&gt; Kind
</span><a href="GHC.Core.TyCo.Subst.html#substTy"><span class="hs-identifier hs-var">substTy</span></a></span><span> </span><span class="annot"><span class="annottext">TCvSubst
</span><a href="#local-6989586621680957308"><span class="hs-identifier hs-var">subst</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957307"><span class="hs-identifier hs-var">fun_ty</span></a></span><span class="hs-special">)</span><span>   </span><span class="hs-comment">-- then there should be a function arrow</span><span>
</span><span id="line-467"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-468"></span><span>    </span><span class="hs-comment">-- See Note [Join points and beta-redexes]</span><span>
</span><span id="line-469"></span><span>    </span><span id="local-6989586621680957283"><span class="annot"><span class="annottext">apply_or_bind_then :: (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957283"><span class="hs-identifier hs-var hs-var">apply_or_bind_then</span></a></span></span><span> </span><span id="local-6989586621680957252"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957252"><span class="hs-identifier hs-var">k</span></a></span></span><span> </span><span id="local-6989586621680957251"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957251"><span class="hs-identifier hs-var">arg</span></a></span></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.html#Lam"><span class="hs-identifier hs-type">Lam</span></a></span><span> </span><span id="local-6989586621680957250"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957250"><span class="hs-identifier hs-var">bndr</span></a></span></span><span> </span><span id="local-6989586621680957249"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957249"><span class="hs-identifier hs-var">body</span></a></span></span><span class="hs-special">)</span><span>
</span><span id="line-470"></span><span>      </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreBind -&gt; CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Make.html#mkCoreLet"><span class="hs-identifier hs-var">mkCoreLet</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr -&gt; CoreBind
forall b. b -&gt; Expr b -&gt; Bind b
</span><a href="GHC.Core.html#NonRec"><span class="hs-identifier hs-var">NonRec</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957250"><span class="hs-identifier hs-var">bndr</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957251"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957252"><span class="hs-identifier hs-var">k</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957249"><span class="hs-identifier hs-var">body</span></a></span><span class="hs-special">)</span><span>    </span><span class="hs-comment">-- Important that arg is fresh!</span><span>
</span><span id="line-471"></span><span>    </span><span class="annot"><a href="#local-6989586621680957283"><span class="hs-identifier hs-var">apply_or_bind_then</span></a></span><span> </span><span id="local-6989586621680957247"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957247"><span class="hs-identifier hs-var">k</span></a></span></span><span> </span><span id="local-6989586621680957246"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957246"><span class="hs-identifier hs-var">arg</span></a></span></span><span> </span><span id="local-6989586621680957245"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957245"><span class="hs-identifier hs-var">fun</span></a></span></span><span>
</span><span id="line-472"></span><span>      </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957247"><span class="hs-identifier hs-var">k</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span> </span><span class="annot"><span class="annottext">SDoc -&gt; CoreExpr -&gt; CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Make.html#mkCoreApp"><span class="hs-identifier hs-var">mkCoreApp</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">String -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#text"><span class="hs-identifier hs-var">text</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><span class="hs-string">&quot;mkWWargs&quot;</span></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957245"><span class="hs-identifier hs-var">fun</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957246"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-473"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#applyToVars"><span class="hs-identifier hs-type">applyToVars</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span>
</span><span id="line-474"></span><span id="applyToVars"><span class="annot"><span class="annottext">applyToVars :: [Id] -&gt; CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#applyToVars"><span class="hs-identifier hs-var hs-var">applyToVars</span></a></span></span><span> </span><span id="local-6989586621680957244"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957244"><span class="hs-identifier hs-var">vars</span></a></span></span><span> </span><span id="local-6989586621680957243"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957243"><span class="hs-identifier hs-var">fn</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; [Id] -&gt; CoreExpr
forall b. Expr b -&gt; [Id] -&gt; Expr b
</span><a href="GHC.Core.html#mkVarApps"><span class="hs-identifier hs-var">mkVarApps</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957243"><span class="hs-identifier hs-var">fn</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957244"><span class="hs-identifier hs-var">vars</span></a></span><span>
</span><span id="line-475"></span><span>
</span><span id="line-476"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_wrap_arg"><span class="hs-identifier hs-type">mk_wrap_arg</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Types.Unique.html#Unique"><span class="hs-identifier hs-type">Unique</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-type">Scaled</span></a></span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Var.html#Id"><span class="hs-identifier hs-type">Id</span></a></span><span>
</span><span id="line-477"></span><span id="mk_wrap_arg"><span class="annot"><span class="annottext">mk_wrap_arg :: Unique -&gt; Scaled Kind -&gt; Demand -&gt; Id
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_wrap_arg"><span class="hs-identifier hs-var hs-var">mk_wrap_arg</span></a></span></span><span> </span><span id="local-6989586621680957241"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957241"><span class="hs-identifier hs-var">uniq</span></a></span></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-type">Scaled</span></a></span><span> </span><span id="local-6989586621680957240"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957240"><span class="hs-identifier hs-var">w</span></a></span></span><span> </span><span id="local-6989586621680957239"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957239"><span class="hs-identifier hs-var">ty</span></a></span></span><span class="hs-special">)</span><span> </span><span id="local-6989586621680957238"><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957238"><span class="hs-identifier hs-var">dmd</span></a></span></span><span>
</span><span id="line-478"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">FastString -&gt; Unique -&gt; Kind -&gt; Kind -&gt; Id
</span><a href="GHC.Types.Id.html#mkSysLocalOrCoVar"><span class="hs-identifier hs-var">mkSysLocalOrCoVar</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">String -&gt; FastString
</span><a href="GHC.Data.FastString.html#fsLit"><span class="hs-identifier hs-var">fsLit</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><span class="hs-string">&quot;w&quot;</span></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957241"><span class="hs-identifier hs-var">uniq</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957240"><span class="hs-identifier hs-var">w</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957239"><span class="hs-identifier hs-var">ty</span></a></span><span>
</span><span id="line-479"></span><span>       </span><span class="annot"><span class="annottext">Id -&gt; Demand -&gt; Id
</span><a href="GHC.Types.Id.html#setIdDemandInfo"><span class="hs-operator hs-var">`setIdDemandInfo`</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957238"><span class="hs-identifier hs-var">dmd</span></a></span><span>
</span><span id="line-480"></span><span>
</span><span id="line-481"></span><span class="hs-comment">{- Note [Freshen WW arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Wen we do a worker/wrapper split, we must not in-scope names as the arguments
of the worker, else we'll get name capture.  E.g.

   -- y1 is in scope from further out
   f x = ..y1..

If we accidentally choose y1 as a worker argument disaster results:

   fww y1 y2 = let x = (y1,y2) in ...y1...

To avoid this:

  * We use a fresh unique for both type-variable and term-variable binders
    Originally we lacked this freshness for type variables, and that led
    to the very obscure #12562.  (A type variable in the worker shadowed
    an outer term-variable binding.)

  * Because of this cloning we have to substitute in the type/kind of the
    new binders.  That's why we carry the TCvSubst through mkWWargs.

    So we need a decent in-scope set, just in case that type/kind
    itself has foralls.  We get this from the free vars of the RHS of the
    function since those are the only variables that might be captured.
    It's a lazy thunk, which will only be poked if the type/kind has a forall.

    Another tricky case was when f :: forall a. a -&gt; forall a. a-&gt;a
    (i.e. with shadowing), and then the worker used the same 'a' twice.

************************************************************************
*                                                                      *
\subsection{Strictness stuff}
*                                                                      *
************************************************************************
-}</span><span>
</span><span id="line-517"></span><span>
</span><span id="line-518"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWstr"><span class="hs-identifier hs-type">mkWWstr</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Driver.Session.html#DynFlags"><span class="hs-identifier hs-type">DynFlags</span></a></span><span>
</span><span id="line-519"></span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span>
</span><span id="line-520"></span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span>    </span><span class="hs-comment">-- True &lt;=&gt; INLINEABLE pragma on this function defn</span><span>
</span><span id="line-521"></span><span>                   </span><span class="hs-comment">-- See Note [Do not unpack class dictionaries]</span><span>
</span><span id="line-522"></span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span>                                </span><span class="hs-comment">-- Wrapper args; have their demand info on them</span><span>
</span><span id="line-523"></span><span>                                                </span><span class="hs-comment">--  *Includes type variables*</span><span>
</span><span id="line-524"></span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Unique.Supply.html#UniqSM"><span class="hs-identifier hs-type">UniqSM</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span class="hs-special">,</span><span>                        </span><span class="hs-comment">-- Is this useful</span><span>
</span><span id="line-525"></span><span>                   </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span>                       </span><span class="hs-comment">-- Worker args</span><span>
</span><span id="line-526"></span><span>                   </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span>        </span><span class="hs-comment">-- Wrapper body, lacking the worker call</span><span>
</span><span id="line-527"></span><span>                                                </span><span class="hs-comment">-- and without its lambdas</span><span>
</span><span id="line-528"></span><span>                                                </span><span class="hs-comment">-- This fn adds the unboxing</span><span>
</span><span id="line-529"></span><span>
</span><span id="line-530"></span><span>                   </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">)</span><span>        </span><span class="hs-comment">-- Worker body, lacking the original body of the function,</span><span>
</span><span id="line-531"></span><span>                                                </span><span class="hs-comment">-- and lacking its lambdas.</span><span>
</span><span id="line-532"></span><span>                                                </span><span class="hs-comment">-- This fn does the reboxing</span><span>
</span><span id="line-533"></span><span id="mkWWstr"><span class="annot"><span class="annottext">mkWWstr :: DynFlags
-&gt; FamInstEnvs
-&gt; Bool
-&gt; [Id]
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWstr"><span class="hs-identifier hs-var hs-var">mkWWstr</span></a></span></span><span> </span><span id="local-6989586621680957234"><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957234"><span class="hs-identifier hs-var">dflags</span></a></span></span><span> </span><span id="local-6989586621680957233"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957233"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957232"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957232"><span class="hs-identifier hs-var">has_inlineable_prag</span></a></span></span><span> </span><span id="local-6989586621680957231"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957231"><span class="hs-identifier hs-var">args</span></a></span></span><span>
</span><span id="line-534"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">[Id]
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="#local-6989586621680957230"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957231"><span class="hs-identifier hs-var">args</span></a></span><span>
</span><span id="line-535"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-536"></span><span>    </span><span id="local-6989586621680957229"><span class="annot"><span class="annottext">go_one :: Id
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="#local-6989586621680957229"><span class="hs-identifier hs-var hs-var">go_one</span></a></span></span><span> </span><span id="local-6989586621680957228"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957228"><span class="hs-identifier hs-var">arg</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DynFlags
-&gt; FamInstEnvs
-&gt; Bool
-&gt; Id
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWstr_one"><span class="hs-identifier hs-var">mkWWstr_one</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957234"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957233"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957232"><span class="hs-identifier hs-var">has_inlineable_prag</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957228"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-537"></span><span>
</span><span id="line-538"></span><span>    </span><span id="local-6989586621680957230"><span class="annot"><span class="annottext">go :: [Id]
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="#local-6989586621680957230"><span class="hs-identifier hs-var hs-var">go</span></a></span></span><span> </span><span class="hs-special">[</span><span class="hs-special">]</span><span>           </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span class="hs-special">,</span><span> </span><span class="hs-special">[</span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-var">nop_fn</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-var">nop_fn</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-539"></span><span>    </span><span class="annot"><a href="#local-6989586621680957230"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957221"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957221"><span class="hs-identifier hs-var">arg</span></a></span></span><span> </span><span class="annot"><span class="hs-glyph hs-type">:</span></span><span> </span><span id="local-6989586621680957220"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957220"><span class="hs-identifier hs-var">args</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-special">{</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957219"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957219"><span class="hs-identifier hs-var">useful1</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957218"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957218"><span class="hs-identifier hs-var">args1</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957217"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957217"><span class="hs-identifier hs-var">wrap_fn1</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957216"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957216"><span class="hs-identifier hs-var">work_fn1</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Id
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="#local-6989586621680957229"><span class="hs-identifier hs-var">go_one</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957221"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-540"></span><span>                         </span><span class="hs-special">;</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957215"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957215"><span class="hs-identifier hs-var">useful2</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957214"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957214"><span class="hs-identifier hs-var">args2</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957213"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957213"><span class="hs-identifier hs-var">wrap_fn2</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957212"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957212"><span class="hs-identifier hs-var">work_fn2</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">[Id]
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="#local-6989586621680957230"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957220"><span class="hs-identifier hs-var">args</span></a></span><span>
</span><span id="line-541"></span><span>                         </span><span class="hs-special">;</span><span> </span><span class="annot"><span class="annottext">(Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957219"><span class="hs-identifier hs-var">useful1</span></a></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">||</span></span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957215"><span class="hs-identifier hs-var">useful2</span></a></span><span>
</span><span id="line-542"></span><span>                                  </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957218"><span class="hs-identifier hs-var">args1</span></a></span><span> </span><span class="annot"><span class="annottext">[Id] -&gt; [Id] -&gt; [Id]
forall a. [a] -&gt; [a] -&gt; [a]
</span><a href="../../base/src/GHC.Base.html#%2B%2B"><span class="hs-operator hs-var">++</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957214"><span class="hs-identifier hs-var">args2</span></a></span><span>
</span><span id="line-543"></span><span>                                  </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957217"><span class="hs-identifier hs-var">wrap_fn1</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957213"><span class="hs-identifier hs-var">wrap_fn2</span></a></span><span>
</span><span id="line-544"></span><span>                                  </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957216"><span class="hs-identifier hs-var">work_fn1</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957212"><span class="hs-identifier hs-var">work_fn2</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-545"></span><span>
</span><span id="line-546"></span><span class="hs-comment">{-
Note [Unpacking arguments with product and polymorphic demands]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The argument is unpacked in a case if it has a product type and has a
strict *and* used demand put on it. I.e., arguments, with demands such
as the following ones:

   &lt;S,U(U, L)&gt;
   &lt;S(L,S),U&gt;

will be unpacked, but

   &lt;S,U&gt; or &lt;B,U&gt;

will not, because the pieces aren't used. This is quite important otherwise
we end up unpacking massive tuples passed to the bottoming function. Example:

        f :: ((Int,Int) -&gt; String) -&gt; (Int,Int) -&gt; a
        f g pr = error (g pr)

        main = print (f fst (1, error &quot;no&quot;))

Does 'main' print &quot;error 1&quot; or &quot;error no&quot;?  We don't really want 'f'
to unbox its second argument.  This actually happened in GHC's onwn
source code, in Packages.applyPackageFlag, which ended up un-boxing
the enormous DynFlags tuple, and being strict in the
as-yet-un-filled-in unitState files.
-}</span><span>
</span><span id="line-574"></span><span>
</span><span id="line-575"></span><span class="hs-comment">----------------------</span><span>
</span><span id="line-576"></span><span class="hs-comment">-- mkWWstr_one wrap_arg = (useful, work_args, wrap_fn, work_fn)</span><span>
</span><span id="line-577"></span><span class="hs-comment">--   *  wrap_fn assumes wrap_arg is in scope,</span><span>
</span><span id="line-578"></span><span class="hs-comment">--        brings into scope work_args (via cases)</span><span>
</span><span id="line-579"></span><span class="hs-comment">--   * work_fn assumes work_args are in scope, a</span><span>
</span><span id="line-580"></span><span class="hs-comment">--        brings into scope wrap_arg (via lets)</span><span>
</span><span id="line-581"></span><span class="hs-comment">-- See Note [How to do the worker/wrapper split]</span><span>
</span><span id="line-582"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWstr_one"><span class="hs-identifier hs-type">mkWWstr_one</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Driver.Session.html#DynFlags"><span class="hs-identifier hs-type">DynFlags</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span>
</span><span id="line-583"></span><span>            </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span>    </span><span class="hs-comment">-- True &lt;=&gt; INLINEABLE pragma on this function defn</span><span>
</span><span id="line-584"></span><span>                       </span><span class="hs-comment">-- See Note [Do not unpack class dictionaries]</span><span>
</span><span id="line-585"></span><span>            </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span>
</span><span id="line-586"></span><span>            </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Unique.Supply.html#UniqSM"><span class="hs-identifier hs-type">UniqSM</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span class="hs-special">,</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-587"></span><span id="mkWWstr_one"><span class="annot"><span class="annottext">mkWWstr_one :: DynFlags
-&gt; FamInstEnvs
-&gt; Bool
-&gt; Id
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWstr_one"><span class="hs-identifier hs-var hs-var">mkWWstr_one</span></a></span></span><span> </span><span id="local-6989586621680957211"><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957211"><span class="hs-identifier hs-var">dflags</span></a></span></span><span> </span><span id="local-6989586621680957210"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957210"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957209"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957209"><span class="hs-identifier hs-var">has_inlineable_prag</span></a></span></span><span> </span><span id="local-6989586621680957208"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957208"><span class="hs-identifier hs-var">arg</span></a></span></span><span>
</span><span id="line-588"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Bool
</span><a href="GHC.Types.Var.html#isTyVar"><span class="hs-identifier hs-var">isTyVar</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957208"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-589"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span class="hs-special">,</span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957208"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span>  </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-var">nop_fn</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-var">nop_fn</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-590"></span><span>
</span><span id="line-591"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Demand -&gt; Bool
forall s u. JointDmd (Str s) (Use u) -&gt; Bool
</span><a href="GHC.Types.Demand.html#isAbsDmd"><span class="hs-identifier hs-var">isAbsDmd</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957206"><span class="hs-identifier hs-var">dmd</span></a></span><span>
</span><span id="line-592"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957205"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957205"><span class="hs-identifier hs-var">work_fn</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">DynFlags -&gt; FamInstEnvs -&gt; Id -&gt; Maybe (CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_absent_let"><span class="hs-identifier hs-var">mk_absent_let</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957211"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957210"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957208"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-593"></span><span>     </span><span class="hs-comment">-- Absent case.  We can't always handle absence for arbitrary</span><span>
</span><span id="line-594"></span><span>     </span><span class="hs-comment">-- unlifted types, so we need to choose just the cases we can</span><span>
</span><span id="line-595"></span><span>     </span><span class="hs-comment">-- (that's what mk_absent_let does)</span><span>
</span><span id="line-596"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">True</span></span><span class="hs-special">,</span><span> </span><span class="hs-special">[</span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-var">nop_fn</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957205"><span class="hs-identifier hs-var">work_fn</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-597"></span><span>
</span><span id="line-598"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957203"><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957203"><span class="hs-identifier hs-var">cs</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957202"><span class="annot"><span class="annottext">DataConAppContext
</span><a href="#local-6989586621680957202"><span class="hs-identifier hs-var">acdc</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
-&gt; Bool -&gt; Kind -&gt; Demand -&gt; Maybe ([Demand], DataConAppContext)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#wantToUnbox"><span class="hs-identifier hs-var">wantToUnbox</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957210"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957209"><span class="hs-identifier hs-var">has_inlineable_prag</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957201"><span class="hs-identifier hs-var">arg_ty</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957206"><span class="hs-identifier hs-var">dmd</span></a></span><span>
</span><span id="line-599"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DynFlags
-&gt; FamInstEnvs
-&gt; Id
-&gt; [Demand]
-&gt; DataConAppContext
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#unbox_one"><span class="hs-identifier hs-var">unbox_one</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957211"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957210"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957208"><span class="hs-identifier hs-var">arg</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957203"><span class="hs-identifier hs-var">cs</span></a></span><span> </span><span class="annot"><span class="annottext">DataConAppContext
</span><a href="#local-6989586621680957202"><span class="hs-identifier hs-var">acdc</span></a></span><span>
</span><span id="line-600"></span><span>
</span><span id="line-601"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>   </span><span class="hs-comment">-- Other cases</span><span>
</span><span id="line-602"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span class="hs-special">,</span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957208"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-var">nop_fn</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-var">nop_fn</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-603"></span><span>
</span><span id="line-604"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-605"></span><span>    </span><span id="local-6989586621680957201"><span class="annot"><span class="annottext">arg_ty :: Kind
</span><a href="#local-6989586621680957201"><span class="hs-identifier hs-var hs-var">arg_ty</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Kind
</span><a href="GHC.Types.Id.html#idType"><span class="hs-identifier hs-var">idType</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957208"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-606"></span><span>    </span><span id="local-6989586621680957206"><span class="annot"><span class="annottext">dmd :: Demand
</span><a href="#local-6989586621680957206"><span class="hs-identifier hs-var hs-var">dmd</span></a></span></span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Demand
</span><a href="GHC.Types.Id.html#idDemandInfo"><span class="hs-identifier hs-var">idDemandInfo</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957208"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-607"></span><span>
</span><span id="line-608"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#wantToUnbox"><span class="hs-identifier hs-type">wantToUnbox</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Maybe"><span class="hs-identifier hs-type">Maybe</span></a></span><span> </span><span class="hs-special">(</span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-609"></span><span id="wantToUnbox"><span class="annot"><span class="annottext">wantToUnbox :: FamInstEnvs
-&gt; Bool -&gt; Kind -&gt; Demand -&gt; Maybe ([Demand], DataConAppContext)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#wantToUnbox"><span class="hs-identifier hs-var hs-var">wantToUnbox</span></a></span></span><span> </span><span id="local-6989586621680957199"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957199"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957198"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957198"><span class="hs-identifier hs-var">has_inlineable_prag</span></a></span></span><span> </span><span id="local-6989586621680957197"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957197"><span class="hs-identifier hs-var">ty</span></a></span></span><span> </span><span id="local-6989586621680957196"><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957196"><span class="hs-identifier hs-var">dmd</span></a></span></span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-610"></span><span>  </span><span class="hs-keyword">case</span><span> </span><span class="annot"><span class="annottext">FamInstEnvs -&gt; Kind -&gt; Maybe DataConAppContext
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitProductType_maybe"><span class="hs-identifier hs-var">deepSplitProductType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957199"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957197"><span class="hs-identifier hs-var">ty</span></a></span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-611"></span><span>    </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957195"><span class="annot"><span class="annottext">dcac :: DataConAppContext
</span><a href="#local-6989586621680957195"><span class="hs-identifier hs-var">dcac</span></a></span></span><span class="hs-glyph">@</span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span class="hs-special">{</span><span> </span><span class="annot"><span class="annottext">dcac_arg_tys :: DataConAppContext -&gt; [(Scaled Kind, StrictnessMark)]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_arg_tys"><span class="hs-identifier hs-var">dcac_arg_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957192"><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957192"><span class="hs-identifier hs-var">con_arg_tys</span></a></span></span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-612"></span><span>      </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Demand -&gt; Bool
forall s u. JointDmd (Str s) (Use u) -&gt; Bool
</span><a href="GHC.Types.Demand.html#isStrictDmd"><span class="hs-identifier hs-var">isStrictDmd</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957196"><span class="hs-identifier hs-var">dmd</span></a></span><span>
</span><span id="line-613"></span><span>      </span><span class="hs-comment">-- See Note [Unpacking arguments with product and polymorphic demands]</span><span>
</span><span id="line-614"></span><span>      </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957190"><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957190"><span class="hs-identifier hs-var">cs</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Demand -&gt; Int -&gt; Maybe [Demand]
</span><a href="#local-6989586621680957189"><span class="hs-identifier hs-var">split_prod_dmd_arity</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957196"><span class="hs-identifier hs-var">dmd</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)] -&gt; Int
forall (t :: * -&gt; *) a. Foldable t =&gt; t a -&gt; Int
</span><a href="../../base/src/Data.Foldable.html#length"><span class="hs-identifier hs-var">length</span></a></span><span> </span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957192"><span class="hs-identifier hs-var">con_arg_tys</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-615"></span><span>      </span><span class="hs-comment">-- See Note [Do not unpack class dictionaries]</span><span>
</span><span id="line-616"></span><span>      </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool
</span><span class="hs-identifier hs-var">not</span></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957198"><span class="hs-identifier hs-var">has_inlineable_prag</span></a></span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool -&gt; Bool
</span><span class="hs-operator hs-var">&amp;&amp;</span></span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Bool
</span><a href="GHC.Core.Predicate.html#isClassPred"><span class="hs-identifier hs-var">isClassPred</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957197"><span class="hs-identifier hs-var">ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-617"></span><span>      </span><span class="hs-comment">-- See Note [mkWWstr and unsafeCoerce]</span><span>
</span><span id="line-618"></span><span>      </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957190"><span class="hs-identifier hs-var">cs</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand] -&gt; [(Scaled Kind, StrictnessMark)] -&gt; Bool
forall a b. [a] -&gt; [b] -&gt; Bool
</span><a href="GHC.Utils.Misc.html#equalLength"><span class="hs-operator hs-var">`equalLength`</span></a></span><span> </span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957192"><span class="hs-identifier hs-var">con_arg_tys</span></a></span><span>
</span><span id="line-619"></span><span>      </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">([Demand], DataConAppContext)
-&gt; Maybe ([Demand], DataConAppContext)
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957190"><span class="hs-identifier hs-var">cs</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">DataConAppContext
</span><a href="#local-6989586621680957195"><span class="hs-identifier hs-var">dcac</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-620"></span><span>    </span><span class="annot"><span class="annottext">Maybe DataConAppContext
</span><span class="hs-identifier">_</span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">Maybe ([Demand], DataConAppContext)
forall a. Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Nothing"><span class="hs-identifier hs-var">Nothing</span></a></span><span>
</span><span id="line-621"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-622"></span><span>    </span><span id="local-6989586621680957189"><span class="annot"><span class="annottext">split_prod_dmd_arity :: Demand -&gt; Int -&gt; Maybe [Demand]
</span><a href="#local-6989586621680957189"><span class="hs-identifier hs-var hs-var">split_prod_dmd_arity</span></a></span></span><span> </span><span id="local-6989586621680957187"><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957187"><span class="hs-identifier hs-var">dmd</span></a></span></span><span> </span><span id="local-6989586621680957186"><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957186"><span class="hs-identifier hs-var">arty</span></a></span></span><span>
</span><span id="line-623"></span><span>      </span><span class="hs-comment">-- For seqDmd, splitProdDmd_maybe will return Nothing (because how would</span><span>
</span><span id="line-624"></span><span>      </span><span class="hs-comment">-- it know the arity?), but it should behave like &lt;S, U(AAAA)&gt;, for some</span><span>
</span><span id="line-625"></span><span>      </span><span class="hs-comment">-- suitable arity</span><span>
</span><span id="line-626"></span><span>      </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Demand -&gt; Bool
</span><a href="GHC.Types.Demand.html#isSeqDmd"><span class="hs-identifier hs-var">isSeqDmd</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957187"><span class="hs-identifier hs-var">dmd</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">[Demand] -&gt; Maybe [Demand]
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Int -&gt; Demand -&gt; [Demand]
forall a. Int -&gt; a -&gt; [a]
</span><a href="../../base/src/GHC.List.html#replicate"><span class="hs-identifier hs-var">replicate</span></a></span><span> </span><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957186"><span class="hs-identifier hs-var">arty</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="GHC.Types.Demand.html#absDmd"><span class="hs-identifier hs-var">absDmd</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-627"></span><span>      </span><span class="hs-comment">-- Otherwise splitProdDmd_maybe does the job</span><span>
</span><span id="line-628"></span><span>      </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Demand -&gt; Maybe [Demand]
</span><a href="GHC.Types.Demand.html#splitProdDmd_maybe"><span class="hs-identifier hs-var">splitProdDmd_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957187"><span class="hs-identifier hs-var">dmd</span></a></span><span>
</span><span id="line-629"></span><span>
</span><span id="line-630"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#unbox_one"><span class="hs-identifier hs-type">unbox_one</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Driver.Session.html#DynFlags"><span class="hs-identifier hs-type">DynFlags</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span>
</span><span id="line-631"></span><span>          </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span class="hs-special">]</span><span>
</span><span id="line-632"></span><span>          </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span>
</span><span id="line-633"></span><span>          </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Unique.Supply.html#UniqSM"><span class="hs-identifier hs-type">UniqSM</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span class="hs-special">,</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Var"><span class="hs-identifier hs-type">Var</span></a></span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-634"></span><span id="unbox_one"><span class="annot"><span class="annottext">unbox_one :: DynFlags
-&gt; FamInstEnvs
-&gt; Id
-&gt; [Demand]
-&gt; DataConAppContext
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#unbox_one"><span class="hs-identifier hs-var hs-var">unbox_one</span></a></span></span><span> </span><span id="local-6989586621680957181"><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957181"><span class="hs-identifier hs-var">dflags</span></a></span></span><span> </span><span id="local-6989586621680957180"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957180"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957179"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957179"><span class="hs-identifier hs-var">arg</span></a></span></span><span> </span><span id="local-6989586621680957178"><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957178"><span class="hs-identifier hs-var">cs</span></a></span></span><span>
</span><span id="line-635"></span><span>          </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span> </span><span class="hs-special">{</span><span> </span><span class="annot"><span class="annottext">dcac_dc :: DataConAppContext -&gt; DataCon
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_dc"><span class="hs-identifier hs-var">dcac_dc</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957176"><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957176"><span class="hs-identifier hs-var">data_con</span></a></span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_tys :: DataConAppContext -&gt; [Kind]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_tys"><span class="hs-identifier hs-var">dcac_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957174"><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957174"><span class="hs-identifier hs-var">inst_tys</span></a></span></span><span>
</span><span id="line-636"></span><span>                            </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_arg_tys :: DataConAppContext -&gt; [(Scaled Kind, StrictnessMark)]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_arg_tys"><span class="hs-identifier hs-var">dcac_arg_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957173"><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957173"><span class="hs-identifier hs-var">inst_con_arg_tys</span></a></span></span><span>
</span><span id="line-637"></span><span>                            </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_co :: DataConAppContext -&gt; Coercion
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_co"><span class="hs-identifier hs-var">dcac_co</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957171"><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957171"><span class="hs-identifier hs-var">co</span></a></span></span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-638"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-special">{</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957170"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957170"><span class="hs-identifier hs-var">uniq1</span></a></span></span><span class="annot"><span class="hs-glyph hs-type">:</span></span><span id="local-6989586621680957169"><span class="annot"><span class="annottext">[Unique]
</span><a href="#local-6989586621680957169"><span class="hs-identifier hs-var">uniqs</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">UniqSM [Unique]
forall (m :: * -&gt; *). MonadUnique m =&gt; m [Unique]
</span><a href="GHC.Types.Unique.Supply.html#getUniquesM"><span class="hs-identifier hs-var">getUniquesM</span></a></span><span>
</span><span id="line-639"></span><span>        </span><span class="hs-special">;</span><span> </span><span class="hs-keyword">let</span><span>   </span><span id="local-6989586621680957167"><span class="annot"><span class="annottext">scale :: Scaled a -&gt; Scaled a
</span><a href="#local-6989586621680957167"><span class="hs-identifier hs-var hs-var">scale</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Scaled a -&gt; Scaled a
forall a. Kind -&gt; Scaled a -&gt; Scaled a
</span><a href="GHC.Core.Multiplicity.html#scaleScaled"><span class="hs-identifier hs-var">scaleScaled</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; Kind
</span><a href="GHC.Types.Id.html#idMult"><span class="hs-identifier hs-var">idMult</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957179"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-640"></span><span>                </span><span id="local-6989586621680957164"><span class="annot"><span class="annottext">scaled_inst_con_arg_tys :: [(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957164"><span class="hs-identifier hs-var hs-var">scaled_inst_con_arg_tys</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">((Scaled Kind, StrictnessMark) -&gt; (Scaled Kind, StrictnessMark))
-&gt; [(Scaled Kind, StrictnessMark)]
-&gt; [(Scaled Kind, StrictnessMark)]
forall a b. (a -&gt; b) -&gt; [a] -&gt; [b]
</span><a href="../../base/src/GHC.Base.html#map"><span class="hs-identifier hs-var">map</span></a></span><span> </span><span class="hs-special">(</span><span class="hs-glyph">\</span><span class="hs-special">(</span><span id="local-6989586621680957163"><span class="annot"><span class="annottext">Scaled Kind
</span><a href="#local-6989586621680957163"><span class="hs-identifier hs-var">t</span></a></span></span><span class="hs-special">,</span><span id="local-6989586621680957162"><span class="annot"><span class="annottext">StrictnessMark
</span><a href="#local-6989586621680957162"><span class="hs-identifier hs-var">s</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Scaled Kind -&gt; Scaled Kind
forall {a}. Scaled a -&gt; Scaled a
</span><a href="#local-6989586621680957167"><span class="hs-identifier hs-var">scale</span></a></span><span> </span><span class="annot"><span class="annottext">Scaled Kind
</span><a href="#local-6989586621680957163"><span class="hs-identifier hs-var">t</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">StrictnessMark
</span><a href="#local-6989586621680957162"><span class="hs-identifier hs-var">s</span></a></span><span class="hs-special">)</span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957173"><span class="hs-identifier hs-var">inst_con_arg_tys</span></a></span><span>
</span><span id="line-641"></span><span>                </span><span class="hs-comment">-- See Note [Add demands for strict constructors]</span><span>
</span><span id="line-642"></span><span>                </span><span id="local-6989586621680957161"><span class="annot"><span class="annottext">cs' :: [Demand]
</span><a href="#local-6989586621680957161"><span class="hs-identifier hs-var hs-var">cs'</span></a></span></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [Demand] -&gt; [Demand]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#addDataConStrictness"><span class="hs-identifier hs-var">addDataConStrictness</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957176"><span class="hs-identifier hs-var">data_con</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957178"><span class="hs-identifier hs-var">cs</span></a></span><span>
</span><span id="line-643"></span><span>                </span><span id="local-6989586621680957159"><span class="annot"><span class="annottext">unpk_args :: [Id]
</span><a href="#local-6989586621680957159"><span class="hs-identifier hs-var hs-var">unpk_args</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Demand -&gt; Id)
-&gt; [Unique] -&gt; [(Scaled Kind, StrictnessMark)] -&gt; [Demand] -&gt; [Id]
forall a b c d. (a -&gt; b -&gt; c -&gt; d) -&gt; [a] -&gt; [b] -&gt; [c] -&gt; [d]
</span><a href="../../base/src/GHC.List.html#zipWith3"><span class="hs-identifier hs-var">zipWith3</span></a></span><span> </span><span class="annot"><span class="annottext">Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Demand -&gt; Id
</span><a href="#local-6989586621680957157"><span class="hs-identifier hs-var">mk_ww_arg</span></a></span><span> </span><span class="annot"><span class="annottext">[Unique]
</span><a href="#local-6989586621680957169"><span class="hs-identifier hs-var">uniqs</span></a></span><span> </span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957164"><span class="hs-identifier hs-var">scaled_inst_con_arg_tys</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957161"><span class="hs-identifier hs-var">cs'</span></a></span><span>
</span><span id="line-644"></span><span>                </span><span id="local-6989586621680957156"><span class="annot"><span class="annottext">unbox_fn :: CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957156"><span class="hs-identifier hs-var hs-var">unbox_fn</span></a></span></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreExpr
-&gt; Coercion
-&gt; Kind
-&gt; Unique
-&gt; DataCon
-&gt; [Id]
-&gt; CoreExpr
-&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkUnpackCase"><span class="hs-identifier hs-var">mkUnpackCase</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr
forall b. Id -&gt; Expr b
</span><a href="GHC.Core.html#Var"><span class="hs-identifier hs-var">Var</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957179"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957171"><span class="hs-identifier hs-var">co</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; Kind
</span><a href="GHC.Types.Id.html#idMult"><span class="hs-identifier hs-var">idMult</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957179"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957170"><span class="hs-identifier hs-var">uniq1</span></a></span><span>
</span><span id="line-645"></span><span>                                         </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957176"><span class="hs-identifier hs-var">data_con</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957159"><span class="hs-identifier hs-var">unpk_args</span></a></span><span>
</span><span id="line-646"></span><span>                </span><span id="local-6989586621680957154"><span class="annot"><span class="annottext">arg_no_unf :: Id
</span><a href="#local-6989586621680957154"><span class="hs-identifier hs-var hs-var">arg_no_unf</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Id
</span><a href="GHC.Types.Id.html#zapStableUnfolding"><span class="hs-identifier hs-var">zapStableUnfolding</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957179"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-647"></span><span>                             </span><span class="hs-comment">-- See Note [Zap unfolding when beta-reducing]</span><span>
</span><span id="line-648"></span><span>                             </span><span class="hs-comment">-- in GHC.Core.Opt.Simplify; and see #13890</span><span>
</span><span id="line-649"></span><span>                </span><span id="local-6989586621680957152"><span class="annot"><span class="annottext">rebox_fn :: CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957152"><span class="hs-identifier hs-var hs-var">rebox_fn</span></a></span></span><span>   </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreBind -&gt; CoreExpr -&gt; CoreExpr
forall b. Bind b -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#Let"><span class="hs-identifier hs-var">Let</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr -&gt; CoreBind
forall b. b -&gt; Expr b -&gt; Bind b
</span><a href="GHC.Core.html#NonRec"><span class="hs-identifier hs-var">NonRec</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957154"><span class="hs-identifier hs-var">arg_no_unf</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957150"><span class="hs-identifier hs-var">con_app</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-650"></span><span>                </span><span id="local-6989586621680957150"><span class="annot"><span class="annottext">con_app :: CoreExpr
</span><a href="#local-6989586621680957150"><span class="hs-identifier hs-var hs-var">con_app</span></a></span></span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [Kind] -&gt; [Id] -&gt; CoreExpr
forall b. DataCon -&gt; [Kind] -&gt; [Id] -&gt; Expr b
</span><a href="GHC.Core.html#mkConApp2"><span class="hs-identifier hs-var">mkConApp2</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957176"><span class="hs-identifier hs-var">data_con</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957174"><span class="hs-identifier hs-var">inst_tys</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957159"><span class="hs-identifier hs-var">unpk_args</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Coercion -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkCast"><span class="hs-operator hs-var">`mkCast`</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkSymCo"><span class="hs-identifier hs-var">mkSymCo</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957171"><span class="hs-identifier hs-var">co</span></a></span><span>
</span><span id="line-651"></span><span>         </span><span class="hs-special">;</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier">_</span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957148"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957148"><span class="hs-identifier hs-var">worker_args</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957147"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957147"><span class="hs-identifier hs-var">wrap_fn</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957146"><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957146"><span class="hs-identifier hs-var">work_fn</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">DynFlags
-&gt; FamInstEnvs
-&gt; Bool
-&gt; [Id]
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWstr"><span class="hs-identifier hs-var">mkWWstr</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957181"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957180"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957159"><span class="hs-identifier hs-var">unpk_args</span></a></span><span>
</span><span id="line-652"></span><span>         </span><span class="hs-special">;</span><span> </span><span class="annot"><span class="annottext">(Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
-&gt; UniqSM (Bool, [Id], CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">True</span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957148"><span class="hs-identifier hs-var">worker_args</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957156"><span class="hs-identifier hs-var">unbox_fn</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957147"><span class="hs-identifier hs-var">wrap_fn</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957146"><span class="hs-identifier hs-var">work_fn</span></a></span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr)
-&gt; (CoreExpr -&gt; CoreExpr) -&gt; CoreExpr -&gt; CoreExpr
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
</span><a href="#local-6989586621680957152"><span class="hs-identifier hs-var">rebox_fn</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-653"></span><span>                           </span><span class="hs-comment">-- Don't pass the arg, rebox instead</span><span>
</span><span id="line-654"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-655"></span><span>    </span><span id="local-6989586621680957157"><span class="annot"><span class="annottext">mk_ww_arg :: Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Demand -&gt; Id
</span><a href="#local-6989586621680957157"><span class="hs-identifier hs-var hs-var">mk_ww_arg</span></a></span></span><span> </span><span id="local-6989586621680957145"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957145"><span class="hs-identifier hs-var">uniq</span></a></span></span><span> </span><span id="local-6989586621680957144"><span class="annot"><span class="annottext">(Scaled Kind, StrictnessMark)
</span><a href="#local-6989586621680957144"><span class="hs-identifier hs-var">ty</span></a></span></span><span> </span><span id="local-6989586621680957143"><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957143"><span class="hs-identifier hs-var">sub_dmd</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Demand -&gt; Id
</span><a href="GHC.Types.Id.html#setIdDemandInfo"><span class="hs-identifier hs-var">setIdDemandInfo</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Id
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_ww_local"><span class="hs-identifier hs-var">mk_ww_local</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957145"><span class="hs-identifier hs-var">uniq</span></a></span><span> </span><span class="annot"><span class="annottext">(Scaled Kind, StrictnessMark)
</span><a href="#local-6989586621680957144"><span class="hs-identifier hs-var">ty</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957143"><span class="hs-identifier hs-var">sub_dmd</span></a></span><span>
</span><span id="line-656"></span><span>
</span><span id="line-657"></span><span class="hs-comment">----------------------</span><span>
</span><span id="line-658"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-type">nop_fn</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span>
</span><span id="line-659"></span><span id="nop_fn"><span class="annot"><span class="annottext">nop_fn :: CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#nop_fn"><span class="hs-identifier hs-var hs-var">nop_fn</span></a></span></span><span> </span><span id="local-6989586621680957141"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957141"><span class="hs-identifier hs-var">body</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957141"><span class="hs-identifier hs-var">body</span></a></span><span>
</span><span id="line-660"></span><span>
</span><span id="line-661"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#addDataConStrictness"><span class="hs-identifier hs-type">addDataConStrictness</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.DataCon.html#DataCon"><span class="hs-identifier hs-type">DataCon</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span class="hs-special">]</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Demand.html#Demand"><span class="hs-identifier hs-type">Demand</span></a></span><span class="hs-special">]</span><span>
</span><span id="line-662"></span><span class="hs-comment">-- See Note [Add demands for strict constructors]</span><span>
</span><span id="line-663"></span><span id="addDataConStrictness"><span class="annot"><span class="annottext">addDataConStrictness :: DataCon -&gt; [Demand] -&gt; [Demand]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#addDataConStrictness"><span class="hs-identifier hs-var hs-var">addDataConStrictness</span></a></span></span><span> </span><span id="local-6989586621680957140"><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957140"><span class="hs-identifier hs-var">con</span></a></span></span><span> </span><span id="local-6989586621680957139"><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957139"><span class="hs-identifier hs-var">ds</span></a></span></span><span>
</span><span id="line-664"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">String
-&gt; (Demand -&gt; StrictnessMark -&gt; Demand)
-&gt; [Demand]
-&gt; [StrictnessMark]
-&gt; [Demand]
forall a b c. String -&gt; (a -&gt; b -&gt; c) -&gt; [a] -&gt; [b] -&gt; [c]
</span><a href="GHC.Utils.Misc.html#zipWithEqual"><span class="hs-identifier hs-var">zipWithEqual</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><span class="hs-string">&quot;addDataConStrictness&quot;</span></span><span> </span><span class="annot"><span class="annottext">Demand -&gt; StrictnessMark -&gt; Demand
</span><a href="#local-6989586621680957137"><span class="hs-identifier hs-var">add</span></a></span><span> </span><span class="annot"><span class="annottext">[Demand]
</span><a href="#local-6989586621680957139"><span class="hs-identifier hs-var">ds</span></a></span><span> </span><span class="annot"><span class="annottext">[StrictnessMark]
</span><a href="#local-6989586621680957136"><span class="hs-identifier hs-var">strs</span></a></span><span>
</span><span id="line-665"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-666"></span><span>    </span><span id="local-6989586621680957136"><span class="annot"><span class="annottext">strs :: [StrictnessMark]
</span><a href="#local-6989586621680957136"><span class="hs-identifier hs-var hs-var">strs</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [StrictnessMark]
</span><a href="GHC.Core.DataCon.html#dataConRepStrictness"><span class="hs-identifier hs-var">dataConRepStrictness</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957140"><span class="hs-identifier hs-var">con</span></a></span><span>
</span><span id="line-667"></span><span>    </span><span id="local-6989586621680957137"><span class="annot"><span class="annottext">add :: Demand -&gt; StrictnessMark -&gt; Demand
</span><a href="#local-6989586621680957137"><span class="hs-identifier hs-var hs-var">add</span></a></span></span><span> </span><span id="local-6989586621680957134"><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957134"><span class="hs-identifier hs-var">dmd</span></a></span></span><span> </span><span id="local-6989586621680957133"><span class="annot"><span class="annottext">StrictnessMark
</span><a href="#local-6989586621680957133"><span class="hs-identifier hs-var">str</span></a></span></span><span> </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">StrictnessMark -&gt; Bool
</span><a href="GHC.Core.DataCon.html#isMarkedStrict"><span class="hs-identifier hs-var">isMarkedStrict</span></a></span><span> </span><span class="annot"><span class="annottext">StrictnessMark
</span><a href="#local-6989586621680957133"><span class="hs-identifier hs-var">str</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Demand -&gt; Demand
</span><a href="GHC.Types.Demand.html#strictifyDmd"><span class="hs-identifier hs-var">strictifyDmd</span></a></span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957134"><span class="hs-identifier hs-var">dmd</span></a></span><span>
</span><span id="line-668"></span><span>                </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>          </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Demand
</span><a href="#local-6989586621680957134"><span class="hs-identifier hs-var">dmd</span></a></span><span>
</span><span id="line-669"></span><span>
</span><span id="line-670"></span><span class="hs-comment">{- Note [How to do the worker/wrapper split]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The worker-wrapper transformation, mkWWstr_one, takes into account
several possibilities to decide if the function is worthy for
splitting:

1. If an argument is absent, it would be silly to pass it to
   the worker.  Hence the isAbsDmd case.  This case must come
   first because a demand like &lt;S,A&gt; or &lt;B,A&gt; is possible.
   E.g. &lt;B,A&gt; comes from a function like
       f x = error &quot;urk&quot;
   and &lt;S,A&gt; can come from Note [Add demands for strict constructors]

2. If the argument is evaluated strictly, and we can split the
   product demand (splitProdDmd_maybe), then unbox it and w/w its
   pieces.  For example

    f :: (Int, Int) -&gt; Int
    f p = (case p of (a,b) -&gt; a) + 1
  is split to
    f :: (Int, Int) -&gt; Int
    f p = case p of (a,b) -&gt; $wf a

    $wf :: Int -&gt; Int
    $wf a = a + 1

  and
    g :: Bool -&gt; (Int, Int) -&gt; Int
    g c p = case p of (a,b) -&gt;
               if c then a else b
  is split to
   g c p = case p of (a,b) -&gt; $gw c a b
   $gw c a b = if c then a else b

2a But do /not/ split if the components are not used; that is, the
   usage is just 'Used' rather than 'UProd'. In this case
   splitProdDmd_maybe returns Nothing.  Otherwise we risk decomposing
   a massive tuple which is barely used.  Example:

        f :: ((Int,Int) -&gt; String) -&gt; (Int,Int) -&gt; a
        f g pr = error (g pr)

        main = print (f fst (1, error &quot;no&quot;))

   Here, f does not take 'pr' apart, and it's stupid to do so.
   Imagine that it had millions of fields. This actually happened
   in GHC itself where the tuple was DynFlags

3. A plain 'seqDmd', which is head-strict with usage UHead, can't
   be split by splitProdDmd_maybe.  But we want it to behave just
   like U(AAAA) for suitable number of absent demands. So we have
   a special case for it, with arity coming from the data constructor.

Note [Worker-wrapper for bottoming functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used not to split if the result is bottom.
[Justification:  there's no efficiency to be gained.]

But it's sometimes bad not to make a wrapper.  Consider
        fw = \x# -&gt; let x = I# x# in case e of
                                        p1 -&gt; error_fn x
                                        p2 -&gt; error_fn x
                                        p3 -&gt; the real stuff
The re-boxing code won't go away unless error_fn gets a wrapper too.
[We don't do reboxing now, but in general it's better to pass an
unboxed thing to f, and have it reboxed in the error cases....]

Note [Add demands for strict constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this program (due to Roman):

    data X a = X !a

    foo :: X Int -&gt; Int -&gt; Int
    foo (X a) n = go 0
     where
       go i | i &lt; n     = a + go (i+1)
            | otherwise = 0

We want the worker for 'foo' too look like this:

    $wfoo :: Int# -&gt; Int# -&gt; Int#

with the first argument unboxed, so that it is not eval'd each time
around the 'go' loop (which would otherwise happen, since 'foo' is not
strict in 'a').  It is sound for the wrapper to pass an unboxed arg
because X is strict, so its argument must be evaluated.  And if we
*don't* pass an unboxed argument, we can't even repair it by adding a
`seq` thus:

    foo (X a) n = a `seq` go 0

because the seq is discarded (very early) since X is strict!

So here's what we do

* We leave the demand-analysis alone.  The demand on 'a' in the
  definition of 'foo' is &lt;L, U(U)&gt;; the strictness info is Lazy
  because foo's body may or may not evaluate 'a'; but the usage info
  says that 'a' is unpacked and its content is used.

* During worker/wrapper, if we unpack a strict constructor (as we do
  for 'foo'), we use 'addDataConStrictness' to bump up the strictness on
  the strict arguments of the data constructor.

* That in turn means that, if the usage info supports doing so
  (i.e. splitProdDmd_maybe returns Just), we will unpack that argument
  -- even though the original demand (e.g. on 'a') was lazy.

* What does &quot;bump up the strictness&quot; mean?  Just add a head-strict
  demand to the strictness!  Even for a demand like &lt;L,A&gt; we can
  safely turn it into &lt;S,A&gt;; remember case (1) of
  Note [How to do the worker/wrapper split].

The net effect is that the w/w transformation is more aggressive about
unpacking the strict arguments of a data constructor, when that
eagerness is supported by the usage info.

There is the usual danger of reboxing, which as usual we ignore. But
if X is monomorphic, and has an UNPACK pragma, then this optimisation
is even more important.  We don't want the wrapper to rebox an unboxed
argument, and pass an Int to $wfoo!

This works in nested situations like

    data family Bar a
    data instance Bar (a, b) = BarPair !(Bar a) !(Bar b)
    newtype instance Bar Int = Bar Int

    foo :: Bar ((Int, Int), Int) -&gt; Int -&gt; Int
    foo f k = case f of BarPair x y -&gt;
              case burble of
                 True -&gt; case x of
                           BarPair p q -&gt; ...
                 False -&gt; ...

The extra eagerness lets us produce a worker of type:
     $wfoo :: Int# -&gt; Int# -&gt; Int# -&gt; Int -&gt; Int
     $wfoo p# q# y# = ...

even though the `case x` is only lazily evaluated.

--------- Historical note ------------
We used to add data-con strictness demands when demand analysing case
expression. However, it was noticed in #15696 that this misses some cases. For
instance, consider the program (from T10482)

    data family Bar a
    data instance Bar (a, b) = BarPair !(Bar a) !(Bar b)
    newtype instance Bar Int = Bar Int

    foo :: Bar ((Int, Int), Int) -&gt; Int -&gt; Int
    foo f k =
      case f of
        BarPair x y -&gt; case burble of
                          True -&gt; case x of
                                    BarPair p q -&gt; ...
                          False -&gt; ...

We really should be able to assume that `p` is already evaluated since it came
from a strict field of BarPair. This strictness would allow us to produce a
worker of type:

    $wfoo :: Int# -&gt; Int# -&gt; Int# -&gt; Int -&gt; Int
    $wfoo p# q# y# = ...

even though the `case x` is only lazily evaluated

Indeed before we fixed #15696 this would happen since we would float the inner
`case x` through the `case burble` to get:

    foo f k =
      case f of
        BarPair x y -&gt; case x of
                          BarPair p q -&gt; case burble of
                                          True -&gt; ...
                                          False -&gt; ...

However, after fixing #15696 this could no longer happen (for the reasons
discussed in ticket:15696#comment:76). This means that the demand placed on `f`
would then be significantly weaker (since the False branch of the case on
`burble` is not strict in `p` or `q`).

Consequently, we now instead account for data-con strictness in mkWWstr_one,
applying the strictness demands to the final result of DmdAnal. The result is
that we get the strict demand signature we wanted even if we can't float
the case on `x` up through the case on `burble`.


Note [mkWWstr and unsafeCoerce]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
By using unsafeCoerce, it is possible to make the number of demands fail to
match the number of constructor arguments; this happened in #8037.
If so, the worker/wrapper split doesn't work right and we get a Core Lint
bug.  The fix here is simply to decline to do w/w if that happens.

Note [Record evaluated-ness in worker/wrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have

   data T = MkT !Int Int

   f :: T -&gt; T
   f x = e

and f's is strict, and has the CPR property.  The we are going to generate
this w/w split

   f x = case x of
           MkT x1 x2 -&gt; case $wf x1 x2 of
                           (# r1, r2 #) -&gt; MkT r1 r2

   $wfw x1 x2 = let x = MkT x1 x2 in
                case e of
                  MkT r1 r2 -&gt; (# r1, r2 #)

Note that

* In the worker $wf, inside 'e' we can be sure that x1 will be
  evaluated (it came from unpacking the argument MkT.  But that's no
  immediately apparent in $wf

* In the wrapper 'f', which we'll inline at call sites, we can be sure
  that 'r1' has been evaluated (because it came from unpacking the result
  MkT.  But that is not immediately apparent from the wrapper code.

Missing these facts isn't unsound, but it loses possible future
opportunities for optimisation.

Solution: use setCaseBndrEvald when creating
 (A) The arg binders x1,x2 in mkWstr_one
         See #13077, test T13077
 (B) The result binders r1,r2 in mkWWcpr_help
         See Trace #13077, test T13077a
         And #13027 comment:20, item (4)
to record that the relevant binder is evaluated.


************************************************************************
*                                                                      *
         Type scrutiny that is specific to demand analysis
*                                                                      *
************************************************************************

Note [Do not unpack class dictionaries]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have
   f :: Ord a =&gt; [a] -&gt; Int -&gt; a
   {-# INLINABLE f #-}
and we worker/wrapper f, we'll get a worker with an INLINABLE pragma
(see Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap),
which can still be specialised by the type-class specialiser, something like
   fw :: Ord a =&gt; [a] -&gt; Int# -&gt; a

BUT if f is strict in the Ord dictionary, we might unpack it, to get
   fw :: (a-&gt;a-&gt;Bool) -&gt; [a] -&gt; Int# -&gt; a
and the type-class specialiser can't specialise that.  An example is
#6056.

But in any other situation a dictionary is just an ordinary value,
and can be unpacked.  So we track the INLINABLE pragma, and switch
off the unpacking in mkWWstr_one (see the isClassPred test).

Historical note: #14955 describes how I got this fix wrong
the first time.
-}</span><span>
</span><span id="line-936"></span><span>
</span><span id="line-937"></span><span class="hs-comment">-- | Context for a 'DataCon' application with a hole for every field, including</span><span>
</span><span id="line-938"></span><span class="hs-comment">-- surrounding coercions.</span><span>
</span><span id="line-939"></span><span class="hs-comment">-- The result of 'deepSplitProductType_maybe' and 'deepSplitCprType_maybe'.</span><span>
</span><span id="line-940"></span><span class="hs-comment">--</span><span>
</span><span id="line-941"></span><span class="hs-comment">-- Example:</span><span>
</span><span id="line-942"></span><span class="hs-comment">--</span><span>
</span><span id="line-943"></span><span class="hs-comment">-- &gt; DataConAppContext Just [Int] [(Lazy, Int)] (co :: Maybe Int ~ First Int)</span><span>
</span><span id="line-944"></span><span class="hs-comment">--</span><span>
</span><span id="line-945"></span><span class="hs-comment">-- represents</span><span>
</span><span id="line-946"></span><span class="hs-comment">--</span><span>
</span><span id="line-947"></span><span class="hs-comment">-- &gt; Just @Int (_1 :: Int) |&gt; co :: First Int</span><span>
</span><span id="line-948"></span><span class="hs-comment">--</span><span>
</span><span id="line-949"></span><span class="hs-comment">-- where _1 is a hole for the first argument. The number of arguments is</span><span>
</span><span id="line-950"></span><span class="hs-comment">-- determined by the length of @arg_tys@.</span><span>
</span><span id="line-951"></span><span class="hs-keyword">data</span><span> </span><span id="DataConAppContext"><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-var">DataConAppContext</span></a></span></span><span>
</span><span id="line-952"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span id="DataConAppContext"><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-var">DataConAppContext</span></a></span></span><span>
</span><span id="line-953"></span><span>  </span><span class="hs-special">{</span><span> </span><span id="dcac_dc"><span class="annot"><span class="annottext">DataConAppContext -&gt; DataCon
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_dc"><span class="hs-identifier hs-var hs-var">dcac_dc</span></a></span></span><span>      </span><span class="hs-glyph">::</span><span> </span><span class="hs-glyph">!</span><span class="annot"><a href="GHC.Core.DataCon.html#DataCon"><span class="hs-identifier hs-type">DataCon</span></a></span><span>
</span><span id="line-954"></span><span>  </span><span class="hs-special">,</span><span> </span><span id="dcac_tys"><span class="annot"><span class="annottext">DataConAppContext -&gt; [Kind]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_tys"><span class="hs-identifier hs-var hs-var">dcac_tys</span></a></span></span><span>     </span><span class="hs-glyph">::</span><span> </span><span class="hs-glyph">!</span><span class="hs-special">[</span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span class="hs-special">]</span><span>
</span><span id="line-955"></span><span>  </span><span class="hs-special">,</span><span> </span><span id="dcac_arg_tys"><span class="annot"><span class="annottext">DataConAppContext -&gt; [(Scaled Kind, StrictnessMark)]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_arg_tys"><span class="hs-identifier hs-var hs-var">dcac_arg_tys</span></a></span></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-glyph">!</span><span class="hs-special">[</span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-type">Scaled</span></a></span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.DataCon.html#StrictnessMark"><span class="hs-identifier hs-type">StrictnessMark</span></a></span><span class="hs-special">)</span><span class="hs-special">]</span><span>
</span><span id="line-956"></span><span>  </span><span class="hs-special">,</span><span> </span><span id="dcac_co"><span class="annot"><span class="annottext">DataConAppContext -&gt; Coercion
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_co"><span class="hs-identifier hs-var hs-var">dcac_co</span></a></span></span><span>      </span><span class="hs-glyph">::</span><span> </span><span class="hs-glyph">!</span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Coercion"><span class="hs-identifier hs-type">Coercion</span></a></span><span>
</span><span id="line-957"></span><span>  </span><span class="hs-special">}</span><span>
</span><span id="line-958"></span><span>
</span><span id="line-959"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitProductType_maybe"><span class="hs-identifier hs-type">deepSplitProductType_maybe</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Maybe"><span class="hs-identifier hs-type">Maybe</span></a></span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span>
</span><span id="line-960"></span><span class="hs-comment">-- If    deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co)</span><span>
</span><span id="line-961"></span><span class="hs-comment">-- then  dc @ tys (args::arg_tys) :: rep_ty</span><span>
</span><span id="line-962"></span><span class="hs-comment">--       co :: ty ~ rep_ty</span><span>
</span><span id="line-963"></span><span class="hs-comment">-- Why do we return the strictness of the data-con arguments?</span><span>
</span><span id="line-964"></span><span class="hs-comment">-- Answer: see Note [Record evaluated-ness in worker/wrapper]</span><span>
</span><span id="line-965"></span><span id="deepSplitProductType_maybe"><span class="annot"><span class="annottext">deepSplitProductType_maybe :: FamInstEnvs -&gt; Kind -&gt; Maybe DataConAppContext
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitProductType_maybe"><span class="hs-identifier hs-var hs-var">deepSplitProductType_maybe</span></a></span></span><span> </span><span id="local-6989586621680957130"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957130"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957129"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957129"><span class="hs-identifier hs-var">ty</span></a></span></span><span>
</span><span id="line-966"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-keyword">let</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957128"><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957128"><span class="hs-identifier hs-var">co</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957127"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957127"><span class="hs-identifier hs-var">ty1</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">FamInstEnvs -&gt; Kind -&gt; Maybe (Coercion, Kind)
</span><a href="GHC.Core.FamInstEnv.html#topNormaliseType_maybe"><span class="hs-identifier hs-var">topNormaliseType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957130"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957129"><span class="hs-identifier hs-var">ty</span></a></span><span>
</span><span id="line-967"></span><span>                    </span><span class="annot"><span class="annottext">Maybe (Coercion, Kind) -&gt; (Coercion, Kind) -&gt; (Coercion, Kind)
forall a. Maybe a -&gt; a -&gt; a
</span><a href="GHC.Data.Maybe.html#orElse"><span class="hs-operator hs-var">`orElse`</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkRepReflCo"><span class="hs-identifier hs-var">mkRepReflCo</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957129"><span class="hs-identifier hs-var">ty</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957129"><span class="hs-identifier hs-var">ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-968"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957123"><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957123"><span class="hs-identifier hs-var">tc</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957122"><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957122"><span class="hs-identifier hs-var">tc_args</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">HasDebugCallStack =&gt; Kind -&gt; Maybe (TyCon, [Kind])
Kind -&gt; Maybe (TyCon, [Kind])
</span><a href="GHC.Core.Type.html#splitTyConApp_maybe"><span class="hs-identifier hs-var">splitTyConApp_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957127"><span class="hs-identifier hs-var">ty1</span></a></span><span>
</span><span id="line-969"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957120"><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957120"><span class="hs-identifier hs-var">con</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">TyCon -&gt; Maybe DataCon
</span><a href="GHC.Core.TyCon.html#isDataProductTyCon_maybe"><span class="hs-identifier hs-var">isDataProductTyCon_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957123"><span class="hs-identifier hs-var">tc</span></a></span><span>
</span><span id="line-970"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="hs-keyword">let</span><span> </span><span id="local-6989586621680957118"><span class="annot"><span class="annottext">arg_tys :: [Scaled Kind]
</span><a href="#local-6989586621680957118"><span class="hs-identifier hs-var hs-var">arg_tys</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [Kind] -&gt; [Scaled Kind]
</span><a href="GHC.Core.DataCon.html#dataConInstArgTys"><span class="hs-identifier hs-var">dataConInstArgTys</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957120"><span class="hs-identifier hs-var">con</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957122"><span class="hs-identifier hs-var">tc_args</span></a></span><span>
</span><span id="line-971"></span><span>        </span><span id="local-6989586621680957116"><span class="annot"><span class="annottext">strict_marks :: [StrictnessMark]
</span><a href="#local-6989586621680957116"><span class="hs-identifier hs-var hs-var">strict_marks</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [StrictnessMark]
</span><a href="GHC.Core.DataCon.html#dataConRepStrictness"><span class="hs-identifier hs-var">dataConRepStrictness</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957120"><span class="hs-identifier hs-var">con</span></a></span><span>
</span><span id="line-972"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataConAppContext -&gt; Maybe DataConAppContext
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="annot"><span class="annottext">DataConAppContext :: DataCon
-&gt; [Kind]
-&gt; [(Scaled Kind, StrictnessMark)]
-&gt; Coercion
-&gt; DataConAppContext
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span> </span><span class="hs-special">{</span><span> </span><span class="annot"><span class="annottext">dcac_dc :: DataCon
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_dc"><span class="hs-identifier hs-var">dcac_dc</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957120"><span class="hs-identifier hs-var">con</span></a></span><span>
</span><span id="line-973"></span><span>                           </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_tys :: [Kind]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_tys"><span class="hs-identifier hs-var">dcac_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957122"><span class="hs-identifier hs-var">tc_args</span></a></span><span>
</span><span id="line-974"></span><span>                           </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_arg_tys :: [(Scaled Kind, StrictnessMark)]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_arg_tys"><span class="hs-identifier hs-var">dcac_arg_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">String
-&gt; [Scaled Kind]
-&gt; [StrictnessMark]
-&gt; [(Scaled Kind, StrictnessMark)]
forall a b. String -&gt; [a] -&gt; [b] -&gt; [(a, b)]
</span><a href="GHC.Utils.Misc.html#zipEqual"><span class="hs-identifier hs-var">zipEqual</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><span class="hs-string">&quot;dspt&quot;</span></span><span> </span><span class="annot"><span class="annottext">[Scaled Kind]
</span><a href="#local-6989586621680957118"><span class="hs-identifier hs-var">arg_tys</span></a></span><span> </span><span class="annot"><span class="annottext">[StrictnessMark]
</span><a href="#local-6989586621680957116"><span class="hs-identifier hs-var">strict_marks</span></a></span><span>
</span><span id="line-975"></span><span>                           </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_co :: Coercion
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_co"><span class="hs-identifier hs-var">dcac_co</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957128"><span class="hs-identifier hs-var">co</span></a></span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-976"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitProductType_maybe"><span class="hs-identifier hs-var">deepSplitProductType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><span class="hs-identifier">_</span></span><span> </span><span class="annot"><span class="annottext">Kind
</span><span class="hs-identifier">_</span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Maybe DataConAppContext
forall a. Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Nothing"><span class="hs-identifier hs-var">Nothing</span></a></span><span>
</span><span id="line-977"></span><span>
</span><span id="line-978"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitCprType_maybe"><span class="hs-identifier hs-type">deepSplitCprType_maybe</span></a></span><span>
</span><span id="line-979"></span><span>  </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Basic.html#ConTag"><span class="hs-identifier hs-type">ConTag</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Maybe"><span class="hs-identifier hs-type">Maybe</span></a></span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span>
</span><span id="line-980"></span><span class="hs-comment">-- If    deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co)</span><span>
</span><span id="line-981"></span><span class="hs-comment">-- then  dc @ tys (args::arg_tys) :: rep_ty</span><span>
</span><span id="line-982"></span><span class="hs-comment">--       co :: ty ~ rep_ty</span><span>
</span><span id="line-983"></span><span class="hs-comment">-- Why do we return the strictness of the data-con arguments?</span><span>
</span><span id="line-984"></span><span class="hs-comment">-- Answer: see Note [Record evaluated-ness in worker/wrapper]</span><span>
</span><span id="line-985"></span><span id="deepSplitCprType_maybe"><span class="annot"><span class="annottext">deepSplitCprType_maybe :: FamInstEnvs -&gt; Int -&gt; Kind -&gt; Maybe DataConAppContext
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitCprType_maybe"><span class="hs-identifier hs-var hs-var">deepSplitCprType_maybe</span></a></span></span><span> </span><span id="local-6989586621680957112"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957112"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957111"><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957111"><span class="hs-identifier hs-var">con_tag</span></a></span></span><span> </span><span id="local-6989586621680957110"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957110"><span class="hs-identifier hs-var">ty</span></a></span></span><span>
</span><span id="line-986"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-keyword">let</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957109"><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957109"><span class="hs-identifier hs-var">co</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957108"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957108"><span class="hs-identifier hs-var">ty1</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">FamInstEnvs -&gt; Kind -&gt; Maybe (Coercion, Kind)
</span><a href="GHC.Core.FamInstEnv.html#topNormaliseType_maybe"><span class="hs-identifier hs-var">topNormaliseType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957112"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957110"><span class="hs-identifier hs-var">ty</span></a></span><span>
</span><span id="line-987"></span><span>                    </span><span class="annot"><span class="annottext">Maybe (Coercion, Kind) -&gt; (Coercion, Kind) -&gt; (Coercion, Kind)
forall a. Maybe a -&gt; a -&gt; a
</span><a href="GHC.Data.Maybe.html#orElse"><span class="hs-operator hs-var">`orElse`</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkRepReflCo"><span class="hs-identifier hs-var">mkRepReflCo</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957110"><span class="hs-identifier hs-var">ty</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957110"><span class="hs-identifier hs-var">ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-988"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957107"><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957107"><span class="hs-identifier hs-var">tc</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957106"><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957106"><span class="hs-identifier hs-var">tc_args</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">HasDebugCallStack =&gt; Kind -&gt; Maybe (TyCon, [Kind])
Kind -&gt; Maybe (TyCon, [Kind])
</span><a href="GHC.Core.Type.html#splitTyConApp_maybe"><span class="hs-identifier hs-var">splitTyConApp_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957108"><span class="hs-identifier hs-var">ty1</span></a></span><span>
</span><span id="line-989"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">TyCon -&gt; Bool
</span><a href="GHC.Core.TyCon.html#isDataTyCon"><span class="hs-identifier hs-var">isDataTyCon</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957107"><span class="hs-identifier hs-var">tc</span></a></span><span>
</span><span id="line-990"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="hs-keyword">let</span><span> </span><span id="local-6989586621680957104"><span class="annot"><span class="annottext">cons :: [DataCon]
</span><a href="#local-6989586621680957104"><span class="hs-identifier hs-var hs-var">cons</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">TyCon -&gt; [DataCon]
</span><a href="GHC.Core.TyCon.html#tyConDataCons"><span class="hs-identifier hs-var">tyConDataCons</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957107"><span class="hs-identifier hs-var">tc</span></a></span><span>
</span><span id="line-991"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">[DataCon]
</span><a href="#local-6989586621680957104"><span class="hs-identifier hs-var">cons</span></a></span><span> </span><span class="annot"><span class="annottext">[DataCon] -&gt; Int -&gt; Bool
forall a. [a] -&gt; Int -&gt; Bool
</span><a href="GHC.Utils.Misc.html#lengthAtLeast"><span class="hs-operator hs-var">`lengthAtLeast`</span></a></span><span> </span><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957111"><span class="hs-identifier hs-var">con_tag</span></a></span><span> </span><span class="hs-comment">-- This might not be true if we import the</span><span>
</span><span id="line-992"></span><span>                                 </span><span class="hs-comment">-- type constructor via a .hs-bool file (#8743)</span><span>
</span><span id="line-993"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="hs-keyword">let</span><span> </span><span id="local-6989586621680957097"><span class="annot"><span class="annottext">con :: DataCon
</span><a href="#local-6989586621680957097"><span class="hs-identifier hs-var hs-var">con</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">[DataCon]
</span><a href="#local-6989586621680957104"><span class="hs-identifier hs-var">cons</span></a></span><span> </span><span class="annot"><span class="annottext">[DataCon] -&gt; Int -&gt; DataCon
forall a. Outputable a =&gt; [a] -&gt; Int -&gt; a
</span><a href="GHC.Data.List.SetOps.html#getNth"><span class="hs-operator hs-var">`getNth`</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957111"><span class="hs-identifier hs-var">con_tag</span></a></span><span> </span><span class="annot"><span class="annottext">Int -&gt; Int -&gt; Int
forall a. Num a =&gt; a -&gt; a -&gt; a
</span><a href="../../base/src/GHC.Num.html#-"><span class="hs-glyph hs-var">-</span></a></span><span> </span><span class="annot"><span class="annottext">Int
</span><a href="GHC.Types.Basic.html#fIRST_TAG"><span class="hs-identifier hs-var">fIRST_TAG</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-994"></span><span>        </span><span id="local-6989586621680957094"><span class="annot"><span class="annottext">arg_tys :: [Scaled Kind]
</span><a href="#local-6989586621680957094"><span class="hs-identifier hs-var hs-var">arg_tys</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [Kind] -&gt; [Scaled Kind]
</span><a href="GHC.Core.DataCon.html#dataConInstArgTys"><span class="hs-identifier hs-var">dataConInstArgTys</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957097"><span class="hs-identifier hs-var">con</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957106"><span class="hs-identifier hs-var">tc_args</span></a></span><span>
</span><span id="line-995"></span><span>        </span><span id="local-6989586621680957093"><span class="annot"><span class="annottext">strict_marks :: [StrictnessMark]
</span><a href="#local-6989586621680957093"><span class="hs-identifier hs-var hs-var">strict_marks</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [StrictnessMark]
</span><a href="GHC.Core.DataCon.html#dataConRepStrictness"><span class="hs-identifier hs-var">dataConRepStrictness</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957097"><span class="hs-identifier hs-var">con</span></a></span><span>
</span><span id="line-996"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">(Scaled Kind -&gt; Bool) -&gt; [Scaled Kind] -&gt; Bool
forall (t :: * -&gt; *) a. Foldable t =&gt; (a -&gt; Bool) -&gt; t a -&gt; Bool
</span><a href="../../base/src/Data.Foldable.html#all"><span class="hs-identifier hs-var">all</span></a></span><span> </span><span class="annot"><span class="annottext">Scaled Kind -&gt; Bool
forall a. Scaled a -&gt; Bool
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#isLinear"><span class="hs-identifier hs-var">isLinear</span></a></span><span> </span><span class="annot"><span class="annottext">[Scaled Kind]
</span><a href="#local-6989586621680957094"><span class="hs-identifier hs-var">arg_tys</span></a></span><span>
</span><span id="line-997"></span><span>  </span><span class="hs-comment">-- Deactivates CPR worker/wrapper splits on constructors with non-linear</span><span>
</span><span id="line-998"></span><span>  </span><span class="hs-comment">-- arguments, for the moment, because they require unboxed tuple with variable</span><span>
</span><span id="line-999"></span><span>  </span><span class="hs-comment">-- multiplicity fields.</span><span>
</span><span id="line-1000"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataConAppContext -&gt; Maybe DataConAppContext
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="annot"><span class="annottext">DataConAppContext :: DataCon
-&gt; [Kind]
-&gt; [(Scaled Kind, StrictnessMark)]
-&gt; Coercion
-&gt; DataConAppContext
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span> </span><span class="hs-special">{</span><span> </span><span class="annot"><span class="annottext">dcac_dc :: DataCon
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_dc"><span class="hs-identifier hs-var">dcac_dc</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957097"><span class="hs-identifier hs-var">con</span></a></span><span>
</span><span id="line-1001"></span><span>                           </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_tys :: [Kind]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_tys"><span class="hs-identifier hs-var">dcac_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957106"><span class="hs-identifier hs-var">tc_args</span></a></span><span>
</span><span id="line-1002"></span><span>                           </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_arg_tys :: [(Scaled Kind, StrictnessMark)]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_arg_tys"><span class="hs-identifier hs-var">dcac_arg_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">String
-&gt; [Scaled Kind]
-&gt; [StrictnessMark]
-&gt; [(Scaled Kind, StrictnessMark)]
forall a b. String -&gt; [a] -&gt; [b] -&gt; [(a, b)]
</span><a href="GHC.Utils.Misc.html#zipEqual"><span class="hs-identifier hs-var">zipEqual</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><span class="hs-string">&quot;dspt&quot;</span></span><span> </span><span class="annot"><span class="annottext">[Scaled Kind]
</span><a href="#local-6989586621680957094"><span class="hs-identifier hs-var">arg_tys</span></a></span><span> </span><span class="annot"><span class="annottext">[StrictnessMark]
</span><a href="#local-6989586621680957093"><span class="hs-identifier hs-var">strict_marks</span></a></span><span>
</span><span id="line-1003"></span><span>                           </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_co :: Coercion
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_co"><span class="hs-identifier hs-var">dcac_co</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957109"><span class="hs-identifier hs-var">co</span></a></span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-1004"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitCprType_maybe"><span class="hs-identifier hs-var">deepSplitCprType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><span class="hs-identifier">_</span></span><span> </span><span class="annot"><span class="annottext">Int
</span><span class="hs-identifier">_</span></span><span> </span><span class="annot"><span class="annottext">Kind
</span><span class="hs-identifier">_</span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Maybe DataConAppContext
forall a. Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Nothing"><span class="hs-identifier hs-var">Nothing</span></a></span><span>
</span><span id="line-1005"></span><span>
</span><span id="line-1006"></span><span id="local-6989586621680957505"><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#isLinear"><span class="hs-identifier hs-type">isLinear</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-type">Scaled</span></a></span><span> </span><span class="annot"><a href="#local-6989586621680957505"><span class="hs-identifier hs-type">a</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span></span><span>
</span><span id="line-1007"></span><span id="isLinear"><span class="annot"><span class="annottext">isLinear :: forall a. Scaled a -&gt; Bool
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#isLinear"><span class="hs-identifier hs-var hs-var">isLinear</span></a></span></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-type">Scaled</span></a></span><span> </span><span id="local-6989586621680957090"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957090"><span class="hs-identifier hs-var">w</span></a></span></span><span> </span><span class="annot"><span class="annottext">a
</span><span class="hs-identifier">_</span></span><span> </span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-1008"></span><span>  </span><span class="hs-keyword">case</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957090"><span class="hs-identifier hs-var">w</span></a></span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-1009"></span><span>    </span><span class="annot"><span class="annottext">Kind
</span><a href="GHC.Core.Type.html#One"><span class="hs-identifier hs-var">One</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">True</span></span><span>
</span><span id="line-1010"></span><span>    </span><span class="annot"><span class="annottext">Kind
</span><span class="hs-identifier">_</span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span>
</span><span id="line-1011"></span><span>
</span><span id="line-1012"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#findTypeShape"><span class="hs-identifier hs-type">findTypeShape</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Demand.html#TypeShape"><span class="hs-identifier hs-type">TypeShape</span></a></span><span>
</span><span id="line-1013"></span><span class="hs-comment">-- Uncover the arrow and product shape of a type</span><span>
</span><span id="line-1014"></span><span class="hs-comment">-- The data type TypeShape is defined in GHC.Types.Demand</span><span>
</span><span id="line-1015"></span><span class="hs-comment">-- See Note [Trimming a demand to a type] in GHC.Core.Opt.DmdAnal</span><span>
</span><span id="line-1016"></span><span id="findTypeShape"><span class="annot"><span class="annottext">findTypeShape :: FamInstEnvs -&gt; Kind -&gt; TypeShape
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#findTypeShape"><span class="hs-identifier hs-var hs-var">findTypeShape</span></a></span></span><span> </span><span id="local-6989586621680957088"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957088"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957087"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957087"><span class="hs-identifier hs-var">ty</span></a></span></span><span>
</span><span id="line-1017"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">RecTcChecker -&gt; Kind -&gt; TypeShape
</span><a href="#local-6989586621680957086"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Int -&gt; RecTcChecker -&gt; RecTcChecker
</span><a href="GHC.Core.TyCon.html#setRecTcMaxBound"><span class="hs-identifier hs-var">setRecTcMaxBound</span></a></span><span> </span><span class="annot"><span class="annottext">Int
</span><span class="hs-number">2</span></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="GHC.Core.TyCon.html#initRecTc"><span class="hs-identifier hs-var">initRecTc</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957087"><span class="hs-identifier hs-var">ty</span></a></span><span>
</span><span id="line-1018"></span><span>       </span><span class="hs-comment">-- You might think this bound of 2 is low, but actually</span><span>
</span><span id="line-1019"></span><span>       </span><span class="hs-comment">-- I think even 1 would be fine.  This only bites for recursive</span><span>
</span><span id="line-1020"></span><span>       </span><span class="hs-comment">-- product types, which are rare, and we really don't want</span><span>
</span><span id="line-1021"></span><span>       </span><span class="hs-comment">-- to look deep into such products -- see #18034</span><span>
</span><span id="line-1022"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-1023"></span><span>    </span><span id="local-6989586621680957086"><span class="annot"><span class="annottext">go :: RecTcChecker -&gt; Kind -&gt; TypeShape
</span><a href="#local-6989586621680957086"><span class="hs-identifier hs-var hs-var">go</span></a></span></span><span> </span><span id="local-6989586621680957082"><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957082"><span class="hs-identifier hs-var">rec_tc</span></a></span></span><span> </span><span id="local-6989586621680957081"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957081"><span class="hs-identifier hs-var">ty</span></a></span></span><span>
</span><span id="line-1024"></span><span>       </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind
</span><span class="hs-identifier">_</span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><span class="hs-identifier">_</span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957080"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957080"><span class="hs-identifier hs-var">res</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Maybe (Kind, Kind, Kind)
</span><a href="GHC.Core.Type.html#splitFunTy_maybe"><span class="hs-identifier hs-var">splitFunTy_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957081"><span class="hs-identifier hs-var">ty</span></a></span><span>
</span><span id="line-1025"></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">TypeShape -&gt; TypeShape
</span><a href="GHC.Types.Demand.html#TsFun"><span class="hs-identifier hs-var">TsFun</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">RecTcChecker -&gt; Kind -&gt; TypeShape
</span><a href="#local-6989586621680957086"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957082"><span class="hs-identifier hs-var">rec_tc</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957080"><span class="hs-identifier hs-var">res</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1026"></span><span>
</span><span id="line-1027"></span><span>       </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957078"><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957078"><span class="hs-identifier hs-var">tc</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957077"><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957077"><span class="hs-identifier hs-var">tc_args</span></a></span></span><span class="hs-special">)</span><span>  </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">HasDebugCallStack =&gt; Kind -&gt; Maybe (TyCon, [Kind])
Kind -&gt; Maybe (TyCon, [Kind])
</span><a href="GHC.Core.Type.html#splitTyConApp_maybe"><span class="hs-identifier hs-var">splitTyConApp_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957081"><span class="hs-identifier hs-var">ty</span></a></span><span>
</span><span id="line-1028"></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">RecTcChecker -&gt; TyCon -&gt; [Kind] -&gt; TypeShape
</span><a href="#local-6989586621680957076"><span class="hs-identifier hs-var">go_tc</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957082"><span class="hs-identifier hs-var">rec_tc</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957078"><span class="hs-identifier hs-var">tc</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957077"><span class="hs-identifier hs-var">tc_args</span></a></span><span>
</span><span id="line-1029"></span><span>
</span><span id="line-1030"></span><span>       </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id
</span><span class="hs-identifier">_</span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957075"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957075"><span class="hs-identifier hs-var">ty'</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Maybe (Id, Kind)
</span><a href="GHC.Core.Type.html#splitForAllTy_maybe"><span class="hs-identifier hs-var">splitForAllTy_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957081"><span class="hs-identifier hs-var">ty</span></a></span><span>
</span><span id="line-1031"></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">RecTcChecker -&gt; Kind -&gt; TypeShape
</span><a href="#local-6989586621680957086"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957082"><span class="hs-identifier hs-var">rec_tc</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957075"><span class="hs-identifier hs-var">ty'</span></a></span><span>
</span><span id="line-1032"></span><span>
</span><span id="line-1033"></span><span>       </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-1034"></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">TypeShape
</span><a href="GHC.Types.Demand.html#TsUnk"><span class="hs-identifier hs-var">TsUnk</span></a></span><span>
</span><span id="line-1035"></span><span>
</span><span id="line-1036"></span><span>    </span><span id="local-6989586621680957076"><span class="annot"><span class="annottext">go_tc :: RecTcChecker -&gt; TyCon -&gt; [Kind] -&gt; TypeShape
</span><a href="#local-6989586621680957076"><span class="hs-identifier hs-var hs-var">go_tc</span></a></span></span><span> </span><span id="local-6989586621680957073"><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957073"><span class="hs-identifier hs-var">rec_tc</span></a></span></span><span> </span><span id="local-6989586621680957072"><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957072"><span class="hs-identifier hs-var">tc</span></a></span></span><span> </span><span id="local-6989586621680957071"><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957071"><span class="hs-identifier hs-var">tc_args</span></a></span></span><span>
</span><span id="line-1037"></span><span>       </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Coercion
</span><span class="hs-identifier">_</span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680957070"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957070"><span class="hs-identifier hs-var">rhs</span></a></span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Coercion
</span><span class="hs-identifier">_</span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">FamInstEnvs -&gt; TyCon -&gt; [Kind] -&gt; Maybe (Coercion, Kind, Coercion)
</span><a href="GHC.Core.FamInstEnv.html#topReduceTyFamApp_maybe"><span class="hs-identifier hs-var">topReduceTyFamApp_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957088"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957072"><span class="hs-identifier hs-var">tc</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957071"><span class="hs-identifier hs-var">tc_args</span></a></span><span>
</span><span id="line-1038"></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">RecTcChecker -&gt; Kind -&gt; TypeShape
</span><a href="#local-6989586621680957086"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957073"><span class="hs-identifier hs-var">rec_tc</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957070"><span class="hs-identifier hs-var">rhs</span></a></span><span>
</span><span id="line-1039"></span><span>
</span><span id="line-1040"></span><span>       </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957068"><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957068"><span class="hs-identifier hs-var">con</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">TyCon -&gt; Maybe DataCon
</span><a href="GHC.Core.TyCon.html#isDataProductTyCon_maybe"><span class="hs-identifier hs-var">isDataProductTyCon_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957072"><span class="hs-identifier hs-var">tc</span></a></span><span>
</span><span id="line-1041"></span><span>       </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957067"><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957067"><span class="hs-identifier hs-var">rec_tc</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-keyword">if</span><span> </span><span class="annot"><span class="annottext">TyCon -&gt; Bool
</span><a href="GHC.Core.TyCon.html#isTupleTyCon"><span class="hs-identifier hs-var">isTupleTyCon</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957072"><span class="hs-identifier hs-var">tc</span></a></span><span>
</span><span id="line-1042"></span><span>                        </span><span class="hs-keyword">then</span><span> </span><span class="annot"><span class="annottext">RecTcChecker -&gt; Maybe RecTcChecker
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957073"><span class="hs-identifier hs-var">rec_tc</span></a></span><span>
</span><span id="line-1043"></span><span>                        </span><span class="hs-keyword">else</span><span> </span><span class="annot"><span class="annottext">RecTcChecker -&gt; TyCon -&gt; Maybe RecTcChecker
</span><a href="GHC.Core.TyCon.html#checkRecTc"><span class="hs-identifier hs-var">checkRecTc</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957073"><span class="hs-identifier hs-var">rec_tc</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957072"><span class="hs-identifier hs-var">tc</span></a></span><span>
</span><span id="line-1044"></span><span>         </span><span class="hs-comment">-- We treat tuples specially because they can't cause loops.</span><span>
</span><span id="line-1045"></span><span>         </span><span class="hs-comment">-- Maybe we should do so in checkRecTc.</span><span>
</span><span id="line-1046"></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">[TypeShape] -&gt; TypeShape
</span><a href="GHC.Types.Demand.html#TsProd"><span class="hs-identifier hs-var">TsProd</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">(Scaled Kind -&gt; TypeShape) -&gt; [Scaled Kind] -&gt; [TypeShape]
forall a b. (a -&gt; b) -&gt; [a] -&gt; [b]
</span><a href="../../base/src/GHC.Base.html#map"><span class="hs-identifier hs-var">map</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">RecTcChecker -&gt; Kind -&gt; TypeShape
</span><a href="#local-6989586621680957086"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957067"><span class="hs-identifier hs-var">rec_tc</span></a></span><span> </span><span class="annot"><span class="annottext">(Kind -&gt; TypeShape)
-&gt; (Scaled Kind -&gt; Kind) -&gt; Scaled Kind -&gt; TypeShape
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">Scaled Kind -&gt; Kind
forall a. Scaled a -&gt; a
</span><a href="GHC.Core.TyCo.Rep.html#scaledThing"><span class="hs-identifier hs-var">scaledThing</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">DataCon -&gt; [Kind] -&gt; [Scaled Kind]
</span><a href="GHC.Core.DataCon.html#dataConInstArgTys"><span class="hs-identifier hs-var">dataConInstArgTys</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957068"><span class="hs-identifier hs-var">con</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957071"><span class="hs-identifier hs-var">tc_args</span></a></span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-1047"></span><span>
</span><span id="line-1048"></span><span>       </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957062"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957062"><span class="hs-identifier hs-var">ty'</span></a></span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Coercion
</span><span class="hs-identifier">_</span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">TyCon -&gt; [Kind] -&gt; Maybe (Kind, Coercion)
</span><a href="GHC.Core.Coercion.html#instNewTyCon_maybe"><span class="hs-identifier hs-var">instNewTyCon_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957072"><span class="hs-identifier hs-var">tc</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957071"><span class="hs-identifier hs-var">tc_args</span></a></span><span>
</span><span id="line-1049"></span><span>       </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957060"><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957060"><span class="hs-identifier hs-var">rec_tc</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">RecTcChecker -&gt; TyCon -&gt; Maybe RecTcChecker
</span><a href="GHC.Core.TyCon.html#checkRecTc"><span class="hs-identifier hs-var">checkRecTc</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957073"><span class="hs-identifier hs-var">rec_tc</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680957072"><span class="hs-identifier hs-var">tc</span></a></span><span>
</span><span id="line-1050"></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">RecTcChecker -&gt; Kind -&gt; TypeShape
</span><a href="#local-6989586621680957086"><span class="hs-identifier hs-var">go</span></a></span><span> </span><span class="annot"><span class="annottext">RecTcChecker
</span><a href="#local-6989586621680957060"><span class="hs-identifier hs-var">rec_tc</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957062"><span class="hs-identifier hs-var">ty'</span></a></span><span>
</span><span id="line-1051"></span><span>
</span><span id="line-1052"></span><span>       </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-1053"></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">TypeShape
</span><a href="GHC.Types.Demand.html#TsUnk"><span class="hs-identifier hs-var">TsUnk</span></a></span><span>
</span><span id="line-1054"></span><span>
</span><span id="line-1055"></span><span class="hs-comment">{-
************************************************************************
*                                                                      *
\subsection{CPR stuff}
*                                                                      *
************************************************************************


@mkWWcpr@ takes the worker/wrapper pair produced from the strictness
info and adds in the CPR transformation.  The worker returns an
unboxed tuple containing non-CPR components.  The wrapper takes this
tuple and re-produces the correct structured output.

The non-CPR results appear ordered in the unboxed tuple as if by a
left-to-right traversal of the result structure.
-}</span><span>
</span><span id="line-1071"></span><span>
</span><span id="line-1072"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWcpr"><span class="hs-identifier hs-type">mkWWcpr</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span>
</span><span id="line-1073"></span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span>
</span><span id="line-1074"></span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span>                              </span><span class="hs-comment">-- function body type</span><span>
</span><span id="line-1075"></span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Cpr.html#CprResult"><span class="hs-identifier hs-type">CprResult</span></a></span><span>                         </span><span class="hs-comment">-- CPR analysis results</span><span>
</span><span id="line-1076"></span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Unique.Supply.html#UniqSM"><span class="hs-identifier hs-type">UniqSM</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span class="hs-special">,</span><span>                     </span><span class="hs-comment">-- Is w/w'ing useful?</span><span>
</span><span id="line-1077"></span><span>                   </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span>     </span><span class="hs-comment">-- New wrapper</span><span>
</span><span id="line-1078"></span><span>                   </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span>     </span><span class="hs-comment">-- New worker</span><span>
</span><span id="line-1079"></span><span>                   </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span class="hs-special">)</span><span>                     </span><span class="hs-comment">-- Type of worker's body</span><span>
</span><span id="line-1080"></span><span>
</span><span id="line-1081"></span><span id="mkWWcpr"><span class="annot"><span class="annottext">mkWWcpr :: Bool
-&gt; FamInstEnvs
-&gt; Kind
-&gt; CprResult
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWcpr"><span class="hs-identifier hs-var hs-var">mkWWcpr</span></a></span></span><span> </span><span id="local-6989586621680957059"><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957059"><span class="hs-identifier hs-var">opt_CprAnal</span></a></span></span><span> </span><span id="local-6989586621680957058"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957058"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957057"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957057"><span class="hs-identifier hs-var">body_ty</span></a></span></span><span> </span><span id="local-6989586621680957056"><span class="annot"><span class="annottext">CprResult
</span><a href="#local-6989586621680957056"><span class="hs-identifier hs-var">cpr</span></a></span></span><span>
</span><span id="line-1082"></span><span>    </span><span class="hs-comment">-- CPR explicitly turned off (or in -O0)</span><span>
</span><span id="line-1083"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool
</span><span class="hs-identifier hs-var">not</span></span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="#local-6989586621680957059"><span class="hs-identifier hs-var">opt_CprAnal</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957057"><span class="hs-identifier hs-var">body_ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1084"></span><span>    </span><span class="hs-comment">-- CPR is turned on by default for -O and O2</span><span>
</span><span id="line-1085"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-1086"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">case</span><span> </span><span class="annot"><span class="annottext">CprResult -&gt; Maybe Int
</span><a href="GHC.Types.Cpr.html#asConCpr"><span class="hs-identifier hs-var">asConCpr</span></a></span><span> </span><span class="annot"><span class="annottext">CprResult
</span><a href="#local-6989586621680957056"><span class="hs-identifier hs-var">cpr</span></a></span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-1087"></span><span>       </span><span class="annot"><span class="annottext">Maybe Int
</span><a href="../../base/src/GHC.Maybe.html#Nothing"><span class="hs-identifier hs-var">Nothing</span></a></span><span>      </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">(Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957057"><span class="hs-identifier hs-var">body_ty</span></a></span><span class="hs-special">)</span><span>  </span><span class="hs-comment">-- No CPR info</span><span>
</span><span id="line-1088"></span><span>       </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957054"><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957054"><span class="hs-identifier hs-var">con_tag</span></a></span></span><span> </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680957053"><span class="annot"><span class="annottext">DataConAppContext
</span><a href="#local-6989586621680957053"><span class="hs-identifier hs-var">dcac</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">FamInstEnvs -&gt; Int -&gt; Kind -&gt; Maybe DataConAppContext
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#deepSplitCprType_maybe"><span class="hs-identifier hs-var">deepSplitCprType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957058"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Int
</span><a href="#local-6989586621680957054"><span class="hs-identifier hs-var">con_tag</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957057"><span class="hs-identifier hs-var">body_ty</span></a></span><span>
</span><span id="line-1089"></span><span>                    </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">DataConAppContext
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWcpr_help"><span class="hs-identifier hs-var">mkWWcpr_help</span></a></span><span> </span><span class="annot"><span class="annottext">DataConAppContext
</span><a href="#local-6989586621680957053"><span class="hs-identifier hs-var">dcac</span></a></span><span>
</span><span id="line-1090"></span><span>                    </span><span class="hs-glyph">|</span><span>  </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-1091"></span><span>                       </span><span class="hs-comment">-- See Note [non-algebraic or open body type warning]</span><span>
</span><span id="line-1092"></span><span>                    </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">WARN</span><span class="hs-special">(</span><span> </span><span class="hs-identifier">True</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">text</span><span> </span><span class="hs-string">&quot;mkWWcpr: non-algebraic or open body type&quot;</span><span> </span><span class="hs-operator">&lt;+&gt;</span><span> </span><span class="hs-identifier">ppr</span><span> </span><span class="hs-identifier">body_ty</span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-1093"></span><span>                       </span><span class="annot"><span class="annottext">(Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">False</span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; CoreExpr
forall a. a -&gt; a
</span><a href="../../base/src/GHC.Base.html#id"><span class="hs-identifier hs-var">id</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957057"><span class="hs-identifier hs-var">body_ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1094"></span><span>
</span><span id="line-1095"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWcpr_help"><span class="hs-identifier hs-type">mkWWcpr_help</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span>
</span><span id="line-1096"></span><span>             </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Unique.Supply.html#UniqSM"><span class="hs-identifier hs-type">UniqSM</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="hs-identifier hs-type">Bool</span></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1097"></span><span>
</span><span id="line-1098"></span><span id="mkWWcpr_help"><span class="annot"><span class="annottext">mkWWcpr_help :: DataConAppContext
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkWWcpr_help"><span class="hs-identifier hs-var hs-var">mkWWcpr_help</span></a></span></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#DataConAppContext"><span class="hs-identifier hs-type">DataConAppContext</span></a></span><span> </span><span class="hs-special">{</span><span> </span><span class="annot"><span class="annottext">dcac_dc :: DataConAppContext -&gt; DataCon
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_dc"><span class="hs-identifier hs-var">dcac_dc</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957051"><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957051"><span class="hs-identifier hs-var">data_con</span></a></span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_tys :: DataConAppContext -&gt; [Kind]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_tys"><span class="hs-identifier hs-var">dcac_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957050"><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957050"><span class="hs-identifier hs-var">inst_tys</span></a></span></span><span>
</span><span id="line-1099"></span><span>                                </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_arg_tys :: DataConAppContext -&gt; [(Scaled Kind, StrictnessMark)]
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_arg_tys"><span class="hs-identifier hs-var">dcac_arg_tys</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957049"><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957049"><span class="hs-identifier hs-var">arg_tys</span></a></span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">dcac_co :: DataConAppContext -&gt; Coercion
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#dcac_co"><span class="hs-identifier hs-var">dcac_co</span></a></span><span> </span><span class="hs-glyph">=</span><span> </span><span id="local-6989586621680957048"><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957048"><span class="hs-identifier hs-var">co</span></a></span></span><span> </span><span class="hs-special">}</span><span class="hs-special">)</span><span>
</span><span id="line-1100"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-special">[</span><span id="local-6989586621680957047"><span class="annot"><span class="annottext">arg1 :: (Scaled Kind, StrictnessMark)
</span><a href="#local-6989586621680957047"><span class="hs-identifier hs-var">arg1</span></a></span></span><span class="hs-glyph">@</span><span class="hs-special">(</span><span id="local-6989586621680957046"><span class="annot"><span class="annottext">Scaled Kind
</span><a href="#local-6989586621680957046"><span class="hs-identifier hs-var">arg_ty1</span></a></span></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">StrictnessMark
</span><span class="hs-identifier">_</span></span><span class="hs-special">)</span><span class="hs-special">]</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957049"><span class="hs-identifier hs-var">arg_tys</span></a></span><span>
</span><span id="line-1101"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">HasDebugCallStack =&gt; Kind -&gt; Bool
Kind -&gt; Bool
</span><a href="GHC.Core.Type.html#isUnliftedType"><span class="hs-identifier hs-var">isUnliftedType</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Scaled Kind -&gt; Kind
forall a. Scaled a -&gt; a
</span><a href="GHC.Core.TyCo.Rep.html#scaledThing"><span class="hs-identifier hs-var">scaledThing</span></a></span><span> </span><span class="annot"><span class="annottext">Scaled Kind
</span><a href="#local-6989586621680957046"><span class="hs-identifier hs-var">arg_ty1</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1102"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Scaled Kind -&gt; Bool
forall a. Scaled a -&gt; Bool
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#isLinear"><span class="hs-identifier hs-var">isLinear</span></a></span><span> </span><span class="annot"><span class="annottext">Scaled Kind
</span><a href="#local-6989586621680957046"><span class="hs-identifier hs-var">arg_ty1</span></a></span><span>
</span><span id="line-1103"></span><span>        </span><span class="hs-comment">-- Special case when there is a single result of unlifted, linear, type</span><span>
</span><span id="line-1104"></span><span>        </span><span class="hs-comment">--</span><span>
</span><span id="line-1105"></span><span>        </span><span class="hs-comment">-- Wrapper:     case (..call worker..) of x -&gt; C x</span><span>
</span><span id="line-1106"></span><span>        </span><span class="hs-comment">-- Worker:      case (   ..body..    ) of C x -&gt; x</span><span>
</span><span id="line-1107"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-special">{</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957044"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957044"><span class="hs-identifier hs-var">work_uniq</span></a></span></span><span> </span><span class="annot"><span class="hs-glyph hs-type">:</span></span><span> </span><span id="local-6989586621680957043"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957043"><span class="hs-identifier hs-var">arg_uniq</span></a></span></span><span> </span><span class="annot"><span class="hs-glyph hs-type">:</span></span><span> </span><span class="annot"><span class="annottext">[Unique]
</span><span class="hs-identifier">_</span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">UniqSM [Unique]
forall (m :: * -&gt; *). MonadUnique m =&gt; m [Unique]
</span><a href="GHC.Types.Unique.Supply.html#getUniquesM"><span class="hs-identifier hs-var">getUniquesM</span></a></span><span>
</span><span id="line-1108"></span><span>       </span><span class="hs-special">;</span><span> </span><span class="hs-keyword">let</span><span> </span><span id="local-6989586621680957042"><span class="annot"><span class="annottext">arg :: Id
</span><a href="#local-6989586621680957042"><span class="hs-identifier hs-var hs-var">arg</span></a></span></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Id
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_ww_local"><span class="hs-identifier hs-var">mk_ww_local</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957043"><span class="hs-identifier hs-var">arg_uniq</span></a></span><span> </span><span class="annot"><span class="annottext">(Scaled Kind, StrictnessMark)
</span><a href="#local-6989586621680957047"><span class="hs-identifier hs-var">arg1</span></a></span><span>
</span><span id="line-1109"></span><span>             </span><span id="local-6989586621680957041"><span class="annot"><span class="annottext">con_app :: CoreExpr
</span><a href="#local-6989586621680957041"><span class="hs-identifier hs-var hs-var">con_app</span></a></span></span><span>   </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [Kind] -&gt; [Id] -&gt; CoreExpr
forall b. DataCon -&gt; [Kind] -&gt; [Id] -&gt; Expr b
</span><a href="GHC.Core.html#mkConApp2"><span class="hs-identifier hs-var">mkConApp2</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957051"><span class="hs-identifier hs-var">data_con</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957050"><span class="hs-identifier hs-var">inst_tys</span></a></span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957042"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">]</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Coercion -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkCast"><span class="hs-operator hs-var">`mkCast`</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkSymCo"><span class="hs-identifier hs-var">mkSymCo</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957048"><span class="hs-identifier hs-var">co</span></a></span><span>
</span><span id="line-1110"></span><span>
</span><span id="line-1111"></span><span>       </span><span class="hs-special">;</span><span> </span><span class="annot"><span class="annottext">(Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">True</span></span><span>
</span><span id="line-1112"></span><span>                </span><span class="hs-special">,</span><span> </span><span class="hs-glyph">\</span><span> </span><span id="local-6989586621680957040"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957040"><span class="hs-identifier hs-var">wkr_call</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Id -&gt; CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkDefaultCase"><span class="hs-identifier hs-var">mkDefaultCase</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957040"><span class="hs-identifier hs-var">wkr_call</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957042"><span class="hs-identifier hs-var">arg</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957041"><span class="hs-identifier hs-var">con_app</span></a></span><span>
</span><span id="line-1113"></span><span>                </span><span class="hs-special">,</span><span> </span><span class="hs-glyph">\</span><span> </span><span id="local-6989586621680957039"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957039"><span class="hs-identifier hs-var">body</span></a></span></span><span>     </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">CoreExpr
-&gt; Coercion
-&gt; Kind
-&gt; Unique
-&gt; DataCon
-&gt; [Id]
-&gt; CoreExpr
-&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkUnpackCase"><span class="hs-identifier hs-var">mkUnpackCase</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957039"><span class="hs-identifier hs-var">body</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957048"><span class="hs-identifier hs-var">co</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="GHC.Core.Type.html#One"><span class="hs-identifier hs-var">One</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957044"><span class="hs-identifier hs-var">work_uniq</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957051"><span class="hs-identifier hs-var">data_con</span></a></span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957042"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">]</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr
forall b. Id -&gt; Expr b
</span><a href="GHC.Core.html#varToCoreExpr"><span class="hs-identifier hs-var">varToCoreExpr</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957042"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1114"></span><span>                                </span><span class="hs-comment">-- varToCoreExpr important here: arg can be a coercion</span><span>
</span><span id="line-1115"></span><span>                                </span><span class="hs-comment">-- Lacking this caused #10658</span><span>
</span><span id="line-1116"></span><span>                </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Scaled Kind -&gt; Kind
forall a. Scaled a -&gt; a
</span><a href="GHC.Core.TyCo.Rep.html#scaledThing"><span class="hs-identifier hs-var">scaledThing</span></a></span><span> </span><span class="annot"><span class="annottext">Scaled Kind
</span><a href="#local-6989586621680957046"><span class="hs-identifier hs-var">arg_ty1</span></a></span><span> </span><span class="hs-special">)</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-1117"></span><span>
</span><span id="line-1118"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>   </span><span class="hs-comment">-- The general case</span><span>
</span><span id="line-1119"></span><span>        </span><span class="hs-comment">-- Wrapper: case (..call worker..) of (# a, b #) -&gt; C a b</span><span>
</span><span id="line-1120"></span><span>        </span><span class="hs-comment">-- Worker:  case (   ...body...  ) of C a b -&gt; (# a, b #)</span><span>
</span><span id="line-1121"></span><span>        </span><span class="hs-comment">--</span><span>
</span><span id="line-1122"></span><span>        </span><span class="hs-comment">-- Remark on linearity: in both the case of the wrapper and the worker,</span><span>
</span><span id="line-1123"></span><span>        </span><span class="hs-comment">-- we build a linear case. All the multiplicity information is kept in</span><span>
</span><span id="line-1124"></span><span>        </span><span class="hs-comment">-- the constructors (both C and (#, #)). In particular (#,#) is</span><span>
</span><span id="line-1125"></span><span>        </span><span class="hs-comment">-- parametrised by the multiplicity of its fields. Specifically, in this</span><span>
</span><span id="line-1126"></span><span>        </span><span class="hs-comment">-- instance, the multiplicity of the fields of (#,#) is chosen to be the</span><span>
</span><span id="line-1127"></span><span>        </span><span class="hs-comment">-- same as those of C.</span><span>
</span><span id="line-1128"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-special">{</span><span> </span><span class="hs-special">(</span><span id="local-6989586621680957038"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957038"><span class="hs-identifier hs-var">work_uniq</span></a></span></span><span> </span><span class="annot"><span class="hs-glyph hs-type">:</span></span><span> </span><span id="local-6989586621680957037"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957037"><span class="hs-identifier hs-var">wild_uniq</span></a></span></span><span> </span><span class="annot"><span class="hs-glyph hs-type">:</span></span><span> </span><span id="local-6989586621680957036"><span class="annot"><span class="annottext">[Unique]
</span><a href="#local-6989586621680957036"><span class="hs-identifier hs-var">uniqs</span></a></span></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">UniqSM [Unique]
forall (m :: * -&gt; *). MonadUnique m =&gt; m [Unique]
</span><a href="GHC.Types.Unique.Supply.html#getUniquesM"><span class="hs-identifier hs-var">getUniquesM</span></a></span><span>
</span><span id="line-1129"></span><span>       </span><span class="hs-special">;</span><span> </span><span class="hs-keyword">let</span><span> </span><span id="local-6989586621680957035"><span class="annot"><span class="annottext">wrap_wild :: Id
</span><a href="#local-6989586621680957035"><span class="hs-identifier hs-var hs-var">wrap_wild</span></a></span></span><span>   </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Id
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_ww_local"><span class="hs-identifier hs-var">mk_ww_local</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957037"><span class="hs-identifier hs-var">wild_uniq</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind -&gt; Scaled Kind
forall a. a -&gt; Scaled a
</span><a href="GHC.Core.Type.html#linear"><span class="hs-identifier hs-var">linear</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957033"><span class="hs-identifier hs-var">ubx_tup_ty</span></a></span><span class="hs-special">,</span><span class="annot"><span class="annottext">StrictnessMark
</span><a href="GHC.Core.DataCon.html#MarkedStrict"><span class="hs-identifier hs-var">MarkedStrict</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1130"></span><span>             </span><span id="local-6989586621680957031"><span class="annot"><span class="annottext">args :: [Id]
</span><a href="#local-6989586621680957031"><span class="hs-identifier hs-var hs-var">args</span></a></span></span><span>        </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Id)
-&gt; [Unique] -&gt; [(Scaled Kind, StrictnessMark)] -&gt; [Id]
forall a b c. (a -&gt; b -&gt; c) -&gt; [a] -&gt; [b] -&gt; [c]
</span><a href="../../base/src/GHC.List.html#zipWith"><span class="hs-identifier hs-var">zipWith</span></a></span><span> </span><span class="annot"><span class="annottext">Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Id
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_ww_local"><span class="hs-identifier hs-var">mk_ww_local</span></a></span><span> </span><span class="annot"><span class="annottext">[Unique]
</span><a href="#local-6989586621680957036"><span class="hs-identifier hs-var">uniqs</span></a></span><span> </span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957049"><span class="hs-identifier hs-var">arg_tys</span></a></span><span>
</span><span id="line-1131"></span><span>             </span><span id="local-6989586621680957033"><span class="annot"><span class="annottext">ubx_tup_ty :: Kind
</span><a href="#local-6989586621680957033"><span class="hs-identifier hs-var hs-var">ubx_tup_ty</span></a></span></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Kind
</span><a href="GHC.Core.Utils.html#exprType"><span class="hs-identifier hs-var">exprType</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957029"><span class="hs-identifier hs-var">ubx_tup_app</span></a></span><span>
</span><span id="line-1132"></span><span>             </span><span id="local-6989586621680957029"><span class="annot"><span class="annottext">ubx_tup_app :: CoreExpr
</span><a href="#local-6989586621680957029"><span class="hs-identifier hs-var hs-var">ubx_tup_app</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">[Kind] -&gt; [CoreExpr] -&gt; CoreExpr
</span><a href="GHC.Core.Make.html#mkCoreUbxTup"><span class="hs-identifier hs-var">mkCoreUbxTup</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">((Scaled Kind, StrictnessMark) -&gt; Kind)
-&gt; [(Scaled Kind, StrictnessMark)] -&gt; [Kind]
forall a b. (a -&gt; b) -&gt; [a] -&gt; [b]
</span><a href="../../base/src/GHC.Base.html#map"><span class="hs-identifier hs-var">map</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Scaled Kind -&gt; Kind
forall a. Scaled a -&gt; a
</span><a href="GHC.Core.TyCo.Rep.html#scaledThing"><span class="hs-identifier hs-var">scaledThing</span></a></span><span> </span><span class="annot"><span class="annottext">(Scaled Kind -&gt; Kind)
-&gt; ((Scaled Kind, StrictnessMark) -&gt; Scaled Kind)
-&gt; (Scaled Kind, StrictnessMark)
-&gt; Kind
forall b c a. (b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#."><span class="hs-operator hs-var">.</span></a></span><span> </span><span class="annot"><span class="annottext">(Scaled Kind, StrictnessMark) -&gt; Scaled Kind
forall a b. (a, b) -&gt; a
</span><a href="../../base/src/Data.Tuple.html#fst"><span class="hs-identifier hs-var">fst</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957049"><span class="hs-identifier hs-var">arg_tys</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">(Id -&gt; CoreExpr) -&gt; [Id] -&gt; [CoreExpr]
forall a b. (a -&gt; b) -&gt; [a] -&gt; [b]
</span><a href="../../base/src/GHC.Base.html#map"><span class="hs-identifier hs-var">map</span></a></span><span> </span><span class="annot"><span class="annottext">Id -&gt; CoreExpr
forall b. Id -&gt; Expr b
</span><a href="GHC.Core.html#varToCoreExpr"><span class="hs-identifier hs-var">varToCoreExpr</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957031"><span class="hs-identifier hs-var">args</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1133"></span><span>             </span><span id="local-6989586621680957028"><span class="annot"><span class="annottext">con_app :: CoreExpr
</span><a href="#local-6989586621680957028"><span class="hs-identifier hs-var hs-var">con_app</span></a></span></span><span>     </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DataCon -&gt; [Kind] -&gt; [Id] -&gt; CoreExpr
forall b. DataCon -&gt; [Kind] -&gt; [Id] -&gt; Expr b
</span><a href="GHC.Core.html#mkConApp2"><span class="hs-identifier hs-var">mkConApp2</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957051"><span class="hs-identifier hs-var">data_con</span></a></span><span> </span><span class="annot"><span class="annottext">[Kind]
</span><a href="#local-6989586621680957050"><span class="hs-identifier hs-var">inst_tys</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957031"><span class="hs-identifier hs-var">args</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Coercion -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkCast"><span class="hs-operator hs-var">`mkCast`</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkSymCo"><span class="hs-identifier hs-var">mkSymCo</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957048"><span class="hs-identifier hs-var">co</span></a></span><span>
</span><span id="line-1134"></span><span>             </span><span id="local-6989586621680957026"><span class="annot"><span class="annottext">tup_con :: DataCon
</span><a href="#local-6989586621680957026"><span class="hs-identifier hs-var hs-var">tup_con</span></a></span></span><span>     </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Boxity -&gt; Int -&gt; DataCon
</span><a href="GHC.Builtin.Types.html#tupleDataCon"><span class="hs-identifier hs-var">tupleDataCon</span></a></span><span> </span><span class="annot"><span class="annottext">Boxity
</span><a href="GHC.Types.Basic.html#Unboxed"><span class="hs-identifier hs-var">Unboxed</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)] -&gt; Int
forall (t :: * -&gt; *) a. Foldable t =&gt; t a -&gt; Int
</span><a href="../../base/src/Data.Foldable.html#length"><span class="hs-identifier hs-var">length</span></a></span><span> </span><span class="annot"><span class="annottext">[(Scaled Kind, StrictnessMark)]
</span><a href="#local-6989586621680957049"><span class="hs-identifier hs-var">arg_tys</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1135"></span><span>
</span><span id="line-1136"></span><span>       </span><span class="hs-special">;</span><span> </span><span class="annot"><span class="annottext">(Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
-&gt; UniqSM (Bool, CoreExpr -&gt; CoreExpr, CoreExpr -&gt; CoreExpr, Kind)
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="../../base/src/GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Bool
</span><span class="hs-identifier hs-var">True</span></span><span>
</span><span id="line-1137"></span><span>                </span><span class="hs-special">,</span><span> </span><span class="hs-glyph">\</span><span> </span><span id="local-6989586621680957024"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957024"><span class="hs-identifier hs-var">wkr_call</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Id -&gt; AltCon -&gt; [Id] -&gt; CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkSingleAltCase"><span class="hs-identifier hs-var">mkSingleAltCase</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957024"><span class="hs-identifier hs-var">wkr_call</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957035"><span class="hs-identifier hs-var">wrap_wild</span></a></span><span>
</span><span id="line-1138"></span><span>                                                </span><span class="hs-special">(</span><span class="annot"><span class="annottext">DataCon -&gt; AltCon
</span><a href="GHC.Core.html#DataAlt"><span class="hs-identifier hs-var">DataAlt</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957026"><span class="hs-identifier hs-var">tup_con</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957031"><span class="hs-identifier hs-var">args</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957028"><span class="hs-identifier hs-var">con_app</span></a></span><span>
</span><span id="line-1139"></span><span>                </span><span class="hs-special">,</span><span> </span><span class="hs-glyph">\</span><span> </span><span id="local-6989586621680957022"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957022"><span class="hs-identifier hs-var">body</span></a></span></span><span>     </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">CoreExpr
-&gt; Coercion
-&gt; Kind
-&gt; Unique
-&gt; DataCon
-&gt; [Id]
-&gt; CoreExpr
-&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkUnpackCase"><span class="hs-identifier hs-var">mkUnpackCase</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957022"><span class="hs-identifier hs-var">body</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957048"><span class="hs-identifier hs-var">co</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="GHC.Core.Type.html#One"><span class="hs-identifier hs-var">One</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957038"><span class="hs-identifier hs-var">work_uniq</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957051"><span class="hs-identifier hs-var">data_con</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957031"><span class="hs-identifier hs-var">args</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957029"><span class="hs-identifier hs-var">ubx_tup_app</span></a></span><span>
</span><span id="line-1140"></span><span>                </span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957033"><span class="hs-identifier hs-var">ubx_tup_ty</span></a></span><span> </span><span class="hs-special">)</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-1141"></span><span>
</span><span id="line-1142"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkUnpackCase"><span class="hs-identifier hs-type">mkUnpackCase</span></a></span><span> </span><span class="hs-glyph">::</span><span>  </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Coercion"><span class="hs-identifier hs-type">Coercion</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Mult"><span class="hs-identifier hs-type">Mult</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Unique.html#Unique"><span class="hs-identifier hs-type">Unique</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.DataCon.html#DataCon"><span class="hs-identifier hs-type">DataCon</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">[</span><span class="annot"><a href="GHC.Types.Var.html#Id"><span class="hs-identifier hs-type">Id</span></a></span><span class="hs-special">]</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span>
</span><span id="line-1143"></span><span class="hs-comment">-- (mkUnpackCase e co uniq Con args body)</span><span>
</span><span id="line-1144"></span><span class="hs-comment">--      returns</span><span>
</span><span id="line-1145"></span><span class="hs-comment">-- case e |&gt; co of bndr { Con args -&gt; body }</span><span>
</span><span id="line-1146"></span><span>
</span><span id="line-1147"></span><span id="mkUnpackCase"><span class="annot"><span class="annottext">mkUnpackCase :: CoreExpr
-&gt; Coercion
-&gt; Kind
-&gt; Unique
-&gt; DataCon
-&gt; [Id]
-&gt; CoreExpr
-&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkUnpackCase"><span class="hs-identifier hs-var hs-var">mkUnpackCase</span></a></span></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.html#Tick"><span class="hs-identifier hs-type">Tick</span></a></span><span> </span><span id="local-6989586621680957019"><span class="annot"><span class="annottext">Tickish Id
</span><a href="#local-6989586621680957019"><span class="hs-identifier hs-var">tickish</span></a></span></span><span> </span><span id="local-6989586621680957018"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957018"><span class="hs-identifier hs-var">e</span></a></span></span><span class="hs-special">)</span><span> </span><span id="local-6989586621680957017"><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957017"><span class="hs-identifier hs-var">co</span></a></span></span><span> </span><span id="local-6989586621680957016"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957016"><span class="hs-identifier hs-var">mult</span></a></span></span><span> </span><span id="local-6989586621680957015"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957015"><span class="hs-identifier hs-var">uniq</span></a></span></span><span> </span><span id="local-6989586621680957014"><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957014"><span class="hs-identifier hs-var">con</span></a></span></span><span> </span><span id="local-6989586621680957013"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957013"><span class="hs-identifier hs-var">args</span></a></span></span><span> </span><span id="local-6989586621680957012"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957012"><span class="hs-identifier hs-var">body</span></a></span></span><span>   </span><span class="hs-comment">-- See Note [Profiling and unpacking]</span><span>
</span><span id="line-1148"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Tickish Id -&gt; CoreExpr -&gt; CoreExpr
forall b. Tickish Id -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#Tick"><span class="hs-identifier hs-var">Tick</span></a></span><span> </span><span class="annot"><span class="annottext">Tickish Id
</span><a href="#local-6989586621680957019"><span class="hs-identifier hs-var">tickish</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreExpr
-&gt; Coercion
-&gt; Kind
-&gt; Unique
-&gt; DataCon
-&gt; [Id]
-&gt; CoreExpr
-&gt; CoreExpr
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkUnpackCase"><span class="hs-identifier hs-var">mkUnpackCase</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957018"><span class="hs-identifier hs-var">e</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957017"><span class="hs-identifier hs-var">co</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957016"><span class="hs-identifier hs-var">mult</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957015"><span class="hs-identifier hs-var">uniq</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957014"><span class="hs-identifier hs-var">con</span></a></span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957013"><span class="hs-identifier hs-var">args</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957012"><span class="hs-identifier hs-var">body</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1149"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mkUnpackCase"><span class="hs-identifier hs-var">mkUnpackCase</span></a></span><span> </span><span id="local-6989586621680957011"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957011"><span class="hs-identifier hs-var">scrut</span></a></span></span><span> </span><span id="local-6989586621680957010"><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957010"><span class="hs-identifier hs-var">co</span></a></span></span><span> </span><span id="local-6989586621680957009"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957009"><span class="hs-identifier hs-var">mult</span></a></span></span><span> </span><span id="local-6989586621680957008"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957008"><span class="hs-identifier hs-var">uniq</span></a></span></span><span> </span><span id="local-6989586621680957007"><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957007"><span class="hs-identifier hs-var">boxing_con</span></a></span></span><span> </span><span id="local-6989586621680957006"><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957006"><span class="hs-identifier hs-var">unpk_args</span></a></span></span><span> </span><span id="local-6989586621680957005"><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957005"><span class="hs-identifier hs-var">body</span></a></span></span><span>
</span><span id="line-1150"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Id -&gt; AltCon -&gt; [Id] -&gt; CoreExpr -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkSingleAltCase"><span class="hs-identifier hs-var">mkSingleAltCase</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957004"><span class="hs-identifier hs-var">casted_scrut</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957003"><span class="hs-identifier hs-var">bndr</span></a></span><span>
</span><span id="line-1151"></span><span>                    </span><span class="hs-special">(</span><span class="annot"><span class="annottext">DataCon -&gt; AltCon
</span><a href="GHC.Core.html#DataAlt"><span class="hs-identifier hs-var">DataAlt</span></a></span><span> </span><span class="annot"><span class="annottext">DataCon
</span><a href="#local-6989586621680957007"><span class="hs-identifier hs-var">boxing_con</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">[Id]
</span><a href="#local-6989586621680957006"><span class="hs-identifier hs-var">unpk_args</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957005"><span class="hs-identifier hs-var">body</span></a></span><span>
</span><span id="line-1152"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-1153"></span><span>    </span><span id="local-6989586621680957004"><span class="annot"><span class="annottext">casted_scrut :: CoreExpr
</span><a href="#local-6989586621680957004"><span class="hs-identifier hs-var hs-var">casted_scrut</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957011"><span class="hs-identifier hs-var">scrut</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Coercion -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkCast"><span class="hs-operator hs-var">`mkCast`</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680957010"><span class="hs-identifier hs-var">co</span></a></span><span>
</span><span id="line-1154"></span><span>    </span><span id="local-6989586621680957003"><span class="annot"><span class="annottext">bndr :: Id
</span><a href="#local-6989586621680957003"><span class="hs-identifier hs-var hs-var">bndr</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Id
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_ww_local"><span class="hs-identifier hs-var">mk_ww_local</span></a></span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680957008"><span class="hs-identifier hs-var">uniq</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind -&gt; Kind -&gt; Scaled Kind
forall a. Kind -&gt; a -&gt; Scaled a
</span><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-var">Scaled</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680957009"><span class="hs-identifier hs-var">mult</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreExpr -&gt; Kind
</span><a href="GHC.Core.Utils.html#exprType"><span class="hs-identifier hs-var">exprType</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680957004"><span class="hs-identifier hs-var">casted_scrut</span></a></span><span class="hs-special">)</span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">StrictnessMark
</span><a href="GHC.Core.DataCon.html#MarkedStrict"><span class="hs-identifier hs-var">MarkedStrict</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1155"></span><span>      </span><span class="hs-comment">-- An unpacking case can always be chosen linear, because the variables</span><span>
</span><span id="line-1156"></span><span>      </span><span class="hs-comment">-- are always passed to a constructor. This limits the</span><span>
</span><span id="line-1157"></span><span class="hs-comment">{-
Note [non-algebraic or open body type warning]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

There are a few cases where the W/W transformation is told that something
returns a constructor, but the type at hand doesn't really match this. One
real-world example involves unsafeCoerce:
  foo = IO a
  foo = unsafeCoerce c_exit
  foreign import ccall &quot;c_exit&quot; c_exit :: IO ()
Here CPR will tell you that `foo` returns a () constructor for sure, but trying
to create a worker/wrapper for type `a` obviously fails.
(This was a real example until ee8e792  in libraries/base.)

It does not seem feasible to avoid all such cases already in the analyser (and
after all, the analysis is not really wrong), so we simply do nothing here in
mkWWcpr. But we still want to emit warning with -DDEBUG, to hopefully catch
other cases where something went avoidably wrong.

This warning also triggers for the stream fusion library within `text`.
We can'easily W/W constructed results like `Stream` because we have no simple
way to express existential types in the worker's type signature.

Note [Profiling and unpacking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If the original function looked like
        f = \ x -&gt; {-# SCC &quot;foo&quot; #-} E

then we want the CPR'd worker to look like
        \ x -&gt; {-# SCC &quot;foo&quot; #-} (case E of I# x -&gt; x)
and definitely not
        \ x -&gt; case ({-# SCC &quot;foo&quot; #-} E) of I# x -&gt; x)

This transform doesn't move work or allocation
from one cost centre to another.

Later [SDM]: presumably this is because we want the simplifier to
eliminate the case, and the scc would get in the way?  I'm ok with
including the case itself in the cost centre, since it is morally
part of the function (post transformation) anyway.


************************************************************************
*                                                                      *
\subsection{Utilities}
*                                                                      *
************************************************************************

Note [Absent errors]
~~~~~~~~~~~~~~~~~~~~
We make a new binding for Ids that are marked absent, thus
   let x = absentError &quot;x :: Int&quot;
The idea is that this binding will never be used; but if it
buggily is used we'll get a runtime error message.

Coping with absence for *unlifted* types is important; see, for
example, #4306 and #15627.  In the UnliftedRep case, we can
use LitRubbish, which we need to apply to the required type.
For the unlifted types of singleton kind like Float#, Addr#, etc. we
also find a suitable literal, using Literal.absentLiteralOf.  We don't
have literals for every primitive type, so the function is partial.

Note: I did try the experiment of using an error thunk for unlifted
things too, relying on the simplifier to drop it as dead code.
But this is fragile

 - It fails when profiling is on, which disables various optimisations

 - It fails when reboxing happens. E.g.
      data T = MkT Int Int#
      f p@(MkT a _) = ...g p....
   where g is /lazy/ in 'p', but only uses the first component.  Then
   'f' is /strict/ in 'p', and only uses the first component.  So we only
   pass that component to the worker for 'f', which reconstructs 'p' to
   pass it to 'g'.  Alas we can't say
       ...f (MkT a (absentError Int# &quot;blah&quot;))...
   bacause `MkT` is strict in its Int# argument, so we get an absentError
   exception when we shouldn't.  Very annoying!

So absentError is only used for lifted types.
-}</span><span>
</span><span id="line-1238"></span><span>
</span><span id="line-1239"></span><span class="hs-comment">-- | Tries to find a suitable dummy RHS to bind the given absent identifier to.</span><span>
</span><span id="line-1240"></span><span class="hs-comment">--</span><span>
</span><span id="line-1241"></span><span class="hs-comment">-- If @mk_absent_let _ id == Just wrap@, then @wrap e@ will wrap a let binding</span><span>
</span><span id="line-1242"></span><span class="hs-comment">-- for @id@ with that RHS around @e@. Otherwise, there could no suitable RHS be</span><span>
</span><span id="line-1243"></span><span class="hs-comment">-- found (currently only happens for bindings of 'VecRep' representation).</span><span>
</span><span id="line-1244"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_absent_let"><span class="hs-identifier hs-type">mk_absent_let</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Driver.Session.html#DynFlags"><span class="hs-identifier hs-type">DynFlags</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.FamInstEnv.html#FamInstEnvs"><span class="hs-identifier hs-type">FamInstEnvs</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Var.html#Id"><span class="hs-identifier hs-type">Id</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Maybe"><span class="hs-identifier hs-type">Maybe</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Core.html#CoreExpr"><span class="hs-identifier hs-type">CoreExpr</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1245"></span><span id="mk_absent_let"><span class="annot"><span class="annottext">mk_absent_let :: DynFlags -&gt; FamInstEnvs -&gt; Id -&gt; Maybe (CoreExpr -&gt; CoreExpr)
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_absent_let"><span class="hs-identifier hs-var hs-var">mk_absent_let</span></a></span></span><span> </span><span id="local-6989586621680957002"><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957002"><span class="hs-identifier hs-var">dflags</span></a></span></span><span> </span><span id="local-6989586621680957001"><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957001"><span class="hs-identifier hs-var">fam_envs</span></a></span></span><span> </span><span id="local-6989586621680957000"><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957000"><span class="hs-identifier hs-var">arg</span></a></span></span><span>
</span><span id="line-1246"></span><span>  </span><span class="hs-comment">-- The lifted case: Bind 'absentError'</span><span>
</span><span id="line-1247"></span><span>  </span><span class="hs-comment">-- See Note [Absent errors]</span><span>
</span><span id="line-1248"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool -&gt; Bool
</span><span class="hs-identifier hs-var">not</span></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">HasDebugCallStack =&gt; Kind -&gt; Bool
Kind -&gt; Bool
</span><a href="GHC.Core.Type.html#isUnliftedType"><span class="hs-identifier hs-var">isUnliftedType</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956999"><span class="hs-identifier hs-var">arg_ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1249"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; Maybe (CoreExpr -&gt; CoreExpr)
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreBind -&gt; CoreExpr -&gt; CoreExpr
forall b. Bind b -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#Let"><span class="hs-identifier hs-var">Let</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr -&gt; CoreBind
forall b. b -&gt; Expr b -&gt; Bind b
</span><a href="GHC.Core.html#NonRec"><span class="hs-identifier hs-var">NonRec</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680956998"><span class="hs-identifier hs-var">lifted_arg</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
</span><a href="#local-6989586621680956997"><span class="hs-identifier hs-var">abs_rhs</span></a></span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-1250"></span><span>  </span><span class="hs-comment">-- The 'UnliftedRep' (because polymorphic) case: Bind @__RUBBISH \@arg_ty@</span><span>
</span><span id="line-1251"></span><span>  </span><span class="hs-comment">-- See Note [Absent errors]</span><span>
</span><span id="line-1252"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">PrimRep
</span><a href="GHC.Core.TyCon.html#UnliftedRep"><span class="hs-identifier hs-var">UnliftedRep</span></a></span><span class="hs-special">]</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">HasDebugCallStack =&gt; Kind -&gt; [PrimRep]
Kind -&gt; [PrimRep]
</span><a href="GHC.Types.RepType.html#typePrimRep"><span class="hs-identifier hs-var">typePrimRep</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956999"><span class="hs-identifier hs-var">arg_ty</span></a></span><span>
</span><span id="line-1253"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; Maybe (CoreExpr -&gt; CoreExpr)
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreBind -&gt; CoreExpr -&gt; CoreExpr
forall b. Bind b -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#Let"><span class="hs-identifier hs-var">Let</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr -&gt; CoreBind
forall b. b -&gt; Expr b -&gt; Bind b
</span><a href="GHC.Core.html#NonRec"><span class="hs-identifier hs-var">NonRec</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957000"><span class="hs-identifier hs-var">arg</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr
forall {b}. Expr b
</span><a href="#local-6989586621680956995"><span class="hs-identifier hs-var">unlifted_rhs</span></a></span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-1254"></span><span>  </span><span class="hs-comment">-- The monomorphic unlifted cases: Bind to some literal, if possible</span><span>
</span><span id="line-1255"></span><span>  </span><span class="hs-comment">-- See Note [Absent errors]</span><span>
</span><span id="line-1256"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680956994"><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680956994"><span class="hs-identifier hs-var">tc</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Maybe TyCon
</span><a href="GHC.Core.Type.html#tyConAppTyCon_maybe"><span class="hs-identifier hs-var">tyConAppTyCon_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956992"><span class="hs-identifier hs-var">nty</span></a></span><span>
</span><span id="line-1257"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680956991"><span class="annot"><span class="annottext">Literal
</span><a href="#local-6989586621680956991"><span class="hs-identifier hs-var">lit</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">TyCon -&gt; Maybe Literal
</span><a href="GHC.Types.Literal.html#absentLiteralOf"><span class="hs-identifier hs-var">absentLiteralOf</span></a></span><span> </span><span class="annot"><span class="annottext">TyCon
</span><a href="#local-6989586621680956994"><span class="hs-identifier hs-var">tc</span></a></span><span>
</span><span id="line-1258"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; Maybe (CoreExpr -&gt; CoreExpr)
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreBind -&gt; CoreExpr -&gt; CoreExpr
forall b. Bind b -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#Let"><span class="hs-identifier hs-var">Let</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr -&gt; CoreBind
forall b. b -&gt; Expr b -&gt; Bind b
</span><a href="GHC.Core.html#NonRec"><span class="hs-identifier hs-var">NonRec</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957000"><span class="hs-identifier hs-var">arg</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Literal -&gt; CoreExpr
forall b. Literal -&gt; Expr b
</span><a href="GHC.Core.html#Lit"><span class="hs-identifier hs-var">Lit</span></a></span><span> </span><span class="annot"><span class="annottext">Literal
</span><a href="#local-6989586621680956991"><span class="hs-identifier hs-var">lit</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Coercion -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkCast"><span class="hs-operator hs-var">`mkCast`</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkSymCo"><span class="hs-identifier hs-var">mkSymCo</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680956989"><span class="hs-identifier hs-var">co</span></a></span><span class="hs-special">)</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-1259"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956992"><span class="hs-identifier hs-var">nty</span></a></span><span> </span><span class="annot"><span class="annottext">Kind -&gt; Kind -&gt; Bool
</span><a href="GHC.Core.Type.html#eqType"><span class="hs-operator hs-var">`eqType`</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="GHC.Builtin.Types.Prim.html#voidPrimTy"><span class="hs-identifier hs-var">voidPrimTy</span></a></span><span>
</span><span id="line-1260"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(CoreExpr -&gt; CoreExpr) -&gt; Maybe (CoreExpr -&gt; CoreExpr)
forall a. a -&gt; Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-var">Just</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">CoreBind -&gt; CoreExpr -&gt; CoreExpr
forall b. Bind b -&gt; Expr b -&gt; Expr b
</span><a href="GHC.Core.html#Let"><span class="hs-identifier hs-var">Let</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr -&gt; CoreBind
forall b. b -&gt; Expr b -&gt; Bind b
</span><a href="GHC.Core.html#NonRec"><span class="hs-identifier hs-var">NonRec</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957000"><span class="hs-identifier hs-var">arg</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; CoreExpr
forall b. Id -&gt; Expr b
</span><a href="GHC.Core.html#Var"><span class="hs-identifier hs-var">Var</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="GHC.Types.Id.Make.html#voidPrimId"><span class="hs-identifier hs-var">voidPrimId</span></a></span><span> </span><span class="annot"><span class="annottext">CoreExpr -&gt; Coercion -&gt; CoreExpr
</span><a href="GHC.Core.Utils.html#mkCast"><span class="hs-operator hs-var">`mkCast`</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkSymCo"><span class="hs-identifier hs-var">mkSymCo</span></a></span><span> </span><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680956989"><span class="hs-identifier hs-var">co</span></a></span><span class="hs-special">)</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-1261"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="annot"><span class="annottext">Bool
</span><a href="../../base/src/GHC.Base.html#otherwise"><span class="hs-identifier hs-var">otherwise</span></a></span><span>
</span><span id="line-1262"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">WARN</span><span class="hs-special">(</span><span> </span><span class="hs-identifier">True</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">text</span><span> </span><span class="hs-string">&quot;No absent value for&quot;</span><span> </span><span class="hs-operator">&lt;+&gt;</span><span> </span><span class="hs-identifier">ppr</span><span> </span><span class="hs-identifier">arg_ty</span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-1263"></span><span>    </span><span class="annot"><span class="annottext">Maybe (CoreExpr -&gt; CoreExpr)
forall a. Maybe a
</span><a href="../../base/src/GHC.Maybe.html#Nothing"><span class="hs-identifier hs-var">Nothing</span></a></span><span> </span><span class="hs-comment">-- Can happen for 'State#' and things of 'VecRep'</span><span>
</span><span id="line-1264"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-1265"></span><span>    </span><span id="local-6989586621680956998"><span class="annot"><span class="annottext">lifted_arg :: Id
</span><a href="#local-6989586621680956998"><span class="hs-identifier hs-var hs-var">lifted_arg</span></a></span></span><span>   </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957000"><span class="hs-identifier hs-var">arg</span></a></span><span> </span><span class="annot"><span class="annottext">Id -&gt; StrictSig -&gt; Id
</span><a href="GHC.Types.Id.html#setIdStrictness"><span class="hs-operator hs-var">`setIdStrictness`</span></a></span><span> </span><span class="annot"><span class="annottext">StrictSig
</span><a href="GHC.Types.Demand.html#botSig"><span class="hs-identifier hs-var">botSig</span></a></span><span> </span><span class="annot"><span class="annottext">Id -&gt; CprSig -&gt; Id
</span><a href="GHC.Types.Id.html#setIdCprInfo"><span class="hs-operator hs-var">`setIdCprInfo`</span></a></span><span> </span><span class="annot"><span class="annottext">Int -&gt; CprResult -&gt; CprSig
</span><a href="GHC.Types.Cpr.html#mkCprSig"><span class="hs-identifier hs-var">mkCprSig</span></a></span><span> </span><span class="annot"><span class="annottext">Int
</span><span class="hs-number">0</span></span><span> </span><span class="annot"><span class="annottext">CprResult
</span><a href="GHC.Types.Cpr.html#botCpr"><span class="hs-identifier hs-var">botCpr</span></a></span><span>
</span><span id="line-1266"></span><span>              </span><span class="hs-comment">-- Note in strictness signature that this is bottoming</span><span>
</span><span id="line-1267"></span><span>              </span><span class="hs-comment">-- (for the sake of the &quot;empty case scrutinee not known to</span><span>
</span><span id="line-1268"></span><span>              </span><span class="hs-comment">-- diverge for sure lint&quot; warning)</span><span>
</span><span id="line-1269"></span><span>    </span><span id="local-6989586621680956999"><span class="annot"><span class="annottext">arg_ty :: Kind
</span><a href="#local-6989586621680956999"><span class="hs-identifier hs-var hs-var">arg_ty</span></a></span></span><span>       </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Id -&gt; Kind
</span><a href="GHC.Types.Id.html#idType"><span class="hs-identifier hs-var">idType</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957000"><span class="hs-identifier hs-var">arg</span></a></span><span>
</span><span id="line-1270"></span><span>
</span><span id="line-1271"></span><span>    </span><span class="hs-comment">-- Normalise the type to have best chance of finding an absent literal</span><span>
</span><span id="line-1272"></span><span>    </span><span class="hs-comment">-- e.g. (#17852)   data unlifted N = MkN Int#</span><span>
</span><span id="line-1273"></span><span>    </span><span class="hs-comment">--                 f :: N -&gt; a -&gt; a</span><span>
</span><span id="line-1274"></span><span>    </span><span class="hs-comment">--                 f _ x = x</span><span>
</span><span id="line-1275"></span><span>    </span><span class="hs-special">(</span><span id="local-6989586621680956989"><span class="annot"><span class="annottext">Coercion
</span><a href="#local-6989586621680956989"><span class="hs-identifier hs-var">co</span></a></span></span><span class="hs-special">,</span><span> </span><span id="local-6989586621680956992"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956992"><span class="hs-identifier hs-var">nty</span></a></span></span><span class="hs-special">)</span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">FamInstEnvs -&gt; Kind -&gt; Maybe (Coercion, Kind)
</span><a href="GHC.Core.FamInstEnv.html#topNormaliseType_maybe"><span class="hs-identifier hs-var">topNormaliseType_maybe</span></a></span><span> </span><span class="annot"><span class="annottext">FamInstEnvs
</span><a href="#local-6989586621680957001"><span class="hs-identifier hs-var">fam_envs</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956999"><span class="hs-identifier hs-var">arg_ty</span></a></span><span>
</span><span id="line-1276"></span><span>                   </span><span class="annot"><span class="annottext">Maybe (Coercion, Kind) -&gt; (Coercion, Kind) -&gt; (Coercion, Kind)
forall a. Maybe a -&gt; a -&gt; a
</span><a href="GHC.Data.Maybe.html#orElse"><span class="hs-operator hs-var">`orElse`</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Kind -&gt; Coercion
</span><a href="GHC.Core.Coercion.html#mkRepReflCo"><span class="hs-identifier hs-var">mkRepReflCo</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956999"><span class="hs-identifier hs-var">arg_ty</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956999"><span class="hs-identifier hs-var">arg_ty</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1277"></span><span>
</span><span id="line-1278"></span><span>    </span><span id="local-6989586621680956997"><span class="annot"><span class="annottext">abs_rhs :: CoreExpr
</span><a href="#local-6989586621680956997"><span class="hs-identifier hs-var hs-var">abs_rhs</span></a></span></span><span>      </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Kind -&gt; String -&gt; CoreExpr
</span><a href="GHC.Core.Make.html#mkAbsentErrorApp"><span class="hs-identifier hs-var">mkAbsentErrorApp</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956999"><span class="hs-identifier hs-var">arg_ty</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><a href="#local-6989586621680956982"><span class="hs-identifier hs-var">msg</span></a></span><span>
</span><span id="line-1279"></span><span>    </span><span id="local-6989586621680956982"><span class="annot"><span class="annottext">msg :: String
</span><a href="#local-6989586621680956982"><span class="hs-identifier hs-var hs-var">msg</span></a></span></span><span>          </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">DynFlags -&gt; SDoc -&gt; String
</span><a href="GHC.Utils.Outputable.html#showSDoc"><span class="hs-identifier hs-var">showSDoc</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">DynFlags -&gt; GeneralFlag -&gt; DynFlags
</span><a href="GHC.Driver.Session.html#gopt_set"><span class="hs-identifier hs-var">gopt_set</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957002"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="annot"><span class="annottext">GeneralFlag
</span><a href="GHC.Driver.Flags.html#Opt_SuppressUniques"><span class="hs-identifier hs-var">Opt_SuppressUniques</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1280"></span><span>                            </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; SDoc
forall a. Outputable a =&gt; a -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#ppr"><span class="hs-identifier hs-var">ppr</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957000"><span class="hs-identifier hs-var">arg</span></a></span><span> </span><span class="annot"><span class="annottext">SDoc -&gt; SDoc -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#%3C%2B%3E"><span class="hs-operator hs-var">&lt;+&gt;</span></a></span><span> </span><span class="annot"><span class="annottext">Kind -&gt; SDoc
forall a. Outputable a =&gt; a -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#ppr"><span class="hs-identifier hs-var">ppr</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Id -&gt; Kind
</span><a href="GHC.Types.Id.html#idType"><span class="hs-identifier hs-var">idType</span></a></span><span> </span><span class="annot"><span class="annottext">Id
</span><a href="#local-6989586621680957000"><span class="hs-identifier hs-var">arg</span></a></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">SDoc -&gt; SDoc -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#%3C%2B%3E"><span class="hs-operator hs-var">&lt;+&gt;</span></a></span><span> </span><span class="annot"><span class="annottext">SDoc
</span><a href="#local-6989586621680956975"><span class="hs-identifier hs-var">file_msg</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1281"></span><span>    </span><span id="local-6989586621680956975"><span class="annot"><span class="annottext">file_msg :: SDoc
</span><a href="#local-6989586621680956975"><span class="hs-identifier hs-var hs-var">file_msg</span></a></span></span><span>     </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">case</span><span> </span><span class="annot"><span class="annottext">DynFlags -&gt; Maybe String
</span><a href="GHC.Driver.Session.html#outputFile"><span class="hs-identifier hs-var hs-var">outputFile</span></a></span><span> </span><span class="annot"><span class="annottext">DynFlags
</span><a href="#local-6989586621680957002"><span class="hs-identifier hs-var">dflags</span></a></span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-1282"></span><span>                     </span><span class="annot"><span class="annottext">Maybe String
</span><a href="../../base/src/GHC.Maybe.html#Nothing"><span class="hs-identifier hs-var">Nothing</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">SDoc
</span><a href="GHC.Utils.Outputable.html#empty"><span class="hs-identifier hs-var">empty</span></a></span><span>
</span><span id="line-1283"></span><span>                     </span><span class="annot"><a href="../../base/src/GHC.Maybe.html#Just"><span class="hs-identifier hs-type">Just</span></a></span><span> </span><span id="local-6989586621680956972"><span class="annot"><span class="annottext">String
</span><a href="#local-6989586621680956972"><span class="hs-identifier hs-var">f</span></a></span></span><span>  </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="annottext">String -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#text"><span class="hs-identifier hs-var">text</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><span class="hs-string">&quot;in output file &quot;</span></span><span> </span><span class="annot"><span class="annottext">SDoc -&gt; SDoc -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#%3C%2B%3E"><span class="hs-operator hs-var">&lt;+&gt;</span></a></span><span> </span><span class="annot"><span class="annottext">SDoc -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#quotes"><span class="hs-identifier hs-var">quotes</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">String -&gt; SDoc
</span><a href="GHC.Utils.Outputable.html#text"><span class="hs-identifier hs-var">text</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><a href="#local-6989586621680956972"><span class="hs-identifier hs-var">f</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-1284"></span><span>              </span><span class="hs-comment">-- We need to suppress uniques here because otherwise they'd</span><span>
</span><span id="line-1285"></span><span>              </span><span class="hs-comment">-- end up in the generated code as strings. This is bad for</span><span>
</span><span id="line-1286"></span><span>              </span><span class="hs-comment">-- determinism, because with different uniques the strings</span><span>
</span><span id="line-1287"></span><span>              </span><span class="hs-comment">-- will have different lengths and hence different costs for</span><span>
</span><span id="line-1288"></span><span>              </span><span class="hs-comment">-- the inliner leading to different inlining.</span><span>
</span><span id="line-1289"></span><span>              </span><span class="hs-comment">-- See also Note [Unique Determinism] in GHC.Types.Unique</span><span>
</span><span id="line-1290"></span><span>    </span><span id="local-6989586621680956995"><span class="annot"><span class="annottext">unlifted_rhs :: Expr b
</span><a href="#local-6989586621680956995"><span class="hs-identifier hs-var hs-var">unlifted_rhs</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">Expr b -&gt; [Kind] -&gt; Expr b
forall b. Expr b -&gt; [Kind] -&gt; Expr b
</span><a href="GHC.Core.html#mkTyApps"><span class="hs-identifier hs-var">mkTyApps</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">Literal -&gt; Expr b
forall b. Literal -&gt; Expr b
</span><a href="GHC.Core.html#Lit"><span class="hs-identifier hs-var">Lit</span></a></span><span> </span><span class="annot"><span class="annottext">Literal
</span><a href="GHC.Types.Literal.html#rubbishLit"><span class="hs-identifier hs-var">rubbishLit</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956999"><span class="hs-identifier hs-var">arg_ty</span></a></span><span class="hs-special">]</span><span>
</span><span id="line-1291"></span><span>
</span><span id="line-1292"></span><span class="annot"><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_ww_local"><span class="hs-identifier hs-type">mk_ww_local</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="GHC.Types.Unique.html#Unique"><span class="hs-identifier hs-type">Unique</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-type">Scaled</span></a></span><span> </span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Type"><span class="hs-identifier hs-type">Type</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Core.DataCon.html#StrictnessMark"><span class="hs-identifier hs-type">StrictnessMark</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.Types.Var.html#Id"><span class="hs-identifier hs-type">Id</span></a></span><span>
</span><span id="line-1293"></span><span class="hs-comment">-- The StrictnessMark comes form the data constructor and says</span><span>
</span><span id="line-1294"></span><span class="hs-comment">-- whether this field is strict</span><span>
</span><span id="line-1295"></span><span class="hs-comment">-- See Note [Record evaluated-ness in worker/wrapper]</span><span>
</span><span id="line-1296"></span><span id="mk_ww_local"><span class="annot"><span class="annottext">mk_ww_local :: Unique -&gt; (Scaled Kind, StrictnessMark) -&gt; Id
</span><a href="GHC.Core.Opt.WorkWrap.Utils.html#mk_ww_local"><span class="hs-identifier hs-var hs-var">mk_ww_local</span></a></span></span><span> </span><span id="local-6989586621680956969"><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680956969"><span class="hs-identifier hs-var">uniq</span></a></span></span><span> </span><span class="hs-special">(</span><span class="annot"><a href="GHC.Core.TyCo.Rep.html#Scaled"><span class="hs-identifier hs-type">Scaled</span></a></span><span> </span><span id="local-6989586621680956968"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956968"><span class="hs-identifier hs-var">w</span></a></span></span><span> </span><span id="local-6989586621680956967"><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956967"><span class="hs-identifier hs-var">ty</span></a></span></span><span class="hs-special">,</span><span id="local-6989586621680956966"><span class="annot"><span class="annottext">StrictnessMark
</span><a href="#local-6989586621680956966"><span class="hs-identifier hs-var">str</span></a></span></span><span class="hs-special">)</span><span>
</span><span id="line-1297"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">StrictnessMark -&gt; Id -&gt; Id
</span><a href="GHC.Types.Id.html#setCaseBndrEvald"><span class="hs-identifier hs-var">setCaseBndrEvald</span></a></span><span> </span><span class="annot"><span class="annottext">StrictnessMark
</span><a href="#local-6989586621680956966"><span class="hs-identifier hs-var">str</span></a></span><span> </span><span class="annot"><span class="annottext">(Id -&gt; Id) -&gt; Id -&gt; Id
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span>
</span><span id="line-1298"></span><span>    </span><span class="annot"><span class="annottext">FastString -&gt; Unique -&gt; Kind -&gt; Kind -&gt; Id
</span><a href="GHC.Types.Id.html#mkSysLocalOrCoVar"><span class="hs-identifier hs-var">mkSysLocalOrCoVar</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">String -&gt; FastString
</span><a href="GHC.Data.FastString.html#fsLit"><span class="hs-identifier hs-var">fsLit</span></a></span><span> </span><span class="annot"><span class="annottext">String
</span><span class="hs-string">&quot;ww&quot;</span></span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">Unique
</span><a href="#local-6989586621680956969"><span class="hs-identifier hs-var">uniq</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956968"><span class="hs-identifier hs-var">w</span></a></span><span> </span><span class="annot"><span class="annottext">Kind
</span><a href="#local-6989586621680956967"><span class="hs-identifier hs-var">ty</span></a></span><span>
</span><span id="line-1299"></span></pre></body></html>